:VERSION = 3.00 vfpglry.h$ _classitem vfpglry.hPixels1ClassHeight = 22 Width = 23 cbaseclass = csamplefile = citemhelpfile = vhelpitem = 0 citemtype = Class cpicture = graphics\class.ico Name = "_classitem"  _classitemcustom _gallery.vcx_item1Pixels vfpglry.hs$JArial, 0, 9, 5, 15, 12, 21, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0  itempicker vfpglry.hPixelsClass4form itempicker itempicker vfpglry.hH$ vfpglry.h1 projectpickerJArial, 0, 9, 5, 15, 12, 21, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0  classdropPixelsClass4form classdrop classdropcmdOKLabel1_activexfolder1Class1 vfpglry.h֏$ _programitemClass vfpglry.hPixels1_item _programitemMcitemtype = Program cpicture = graphics\program.ico Name = "_programitem" custom _catalogitem_urlitem vfpglry.hPixelsClass_folder_activexfoldercustom vfpglry.hm'E* _fileitem vfpglry.h^Av(glryreg vfpglry.hPixels vfpglry.hs$ vfpglry.h1PixelsClassPixelsClass vfpglry.h.$ _sampleitem9Class1_item_urlitemcustom _gallery.vcx1cmdOK vfpglry.hv$s$1Name = "errorhandler"  errorhandlerPixels11_item vfpglry.hPixels_itemPixels _formitem _sampleitem vfpglry.hm'E*5 _templateitemcustomPixels vfpglry.h1 vfpglry.hPixelsClassClassform projectpicker _gallery.vcx vfpglry.h^$ _dataitemClass C (CCC@ label.ico report.ico K CCCfLBX&T graphics\ label.ico2'T graphics\ report.icoTCUTHISCPICTURE CFILENAMEFULLPATH addtoproject, addtoformoshared_accesscfilename_assignO dragdrop2dblclick@runmodify+setmenu]Destroyrefreshpicture1q3q3A3q!2qA3qAqA1A3A3A3q"qAqAAA133aqA2cT {w="Wo-$1&>58\qN:R) PROCEDURE getapppath * Checks and returns path of application * associated with a particular extension (e.g., XLS, DOC). LPARAMETER cExtension,cExtnKey,cAppKey,lServer LOCAL nErrNum,cOptName cOptName = "" * Check Extension parameter IF TYPE("m.cExtension") # "C" OR LEN(m.cExtension) > 3 RETURN ERROR_BADPARM ENDIF m.cExtension = "."+m.cExtension * Open extension key nErrNum = THIS.OpenKey(m.cExtension) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Get key value for file extension nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey) * Close extension key THIS.CloseKey() IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer) ENDPROC PROCEDURE getlatestversion LPARAMETER cClass,cExtnKey,cAppKey,lServer LOCAL nErrNum,cOptName cOptName = "" * Open class key (e.g., Excel.Sheet) nErrNum = THIS.OpenKey(m.cClass+CURVER_KEY) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Get key value for file extension nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey) * Close extension key THIS.CloseKey() IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer) ENDPROC PROCEDURE getapplication PARAMETER cExtnKey,cAppKey,lServer LOCAL nErrNum,cOptName cOptName = "" * lServer - checking for OLE server. IF TYPE("m.lServer") = "L" AND m.lServer THIS.cAppPathKey = OLE_PATH_KEY ELSE THIS.cAppPathKey = APP_PATH_KEY ENDIF * Open extension app key m.nErrNum = THIS.OpenKey(m.cExtnKey+THIS.cAppPathKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Get application path nErrNum = THIS.GetKeyValue(cOptName,@cAppKey) * Close application path key THIS.CloseKey() RETURN m.nErrNum ENDPROC PROCEDURE addtoproject LPARAMETER cPJXName THIS.oShared.AddToProject(this.cFileName,m.cPJXName) ENDPROC PROCEDURE addtoform LPARAMETER cSCXName THIS.oShared.AddToForm(THIS,m.cSCXName) ENDPROC PROCEDURE oshared_access IF VARTYPE(THIS.oShared) # "O" THIS.oShared = THIS.oHost.GetObject(OBJ_SHARED) ENDIF RETURN THIS.oShared ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF THIS.oShared.DragDrop2(oSource, nXCoord, nYCoord, THIS) ENDPROC PROCEDURE run THIS.oShared.Run(THIS) ENDPROC PROCEDURE dblclick IF NOT DODEFAULT() RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF IF THIS.oHost.lRunFileDefault THIS.Run() ELSE THIS.Modify() ENDIF ENDPROC PROCEDURE modify THIS.oShared.Modify(THIS) ENDPROC PROCEDURE setmenu LPARAMETERS toObject LOCAL oProjMenu,oFormMenu,lHasForm IF NOT DODEFAULT(toObject) RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF this.AddMenuBar(MENU_MODIFY_LOC,"oTHIS.Modify()",,,,,!this.oHost.lRunFileDefault) this.AddMenuBar(MENU_RUN_LOC,"oTHIS.Run()",,,,,this.oHost.lRunFileDefault) this.AddMenuSeparator oProjMenu = THIS.NewMenu() THIS.oShared.AddProjectMenu(@oProjMenu) this.AddMenuBar(MENU_ADDPROJECT_LOC,oProjMenu,,,,_VFP.PROJECTS.COUNT=0) oFormMenu = THIS.NewMenu() lHasForm = THIS.oShared.AddFormMenu(@oFormMenu) this.AddMenuBar(MENU_ADDFORM_LOC,oFormMenu,,,,!lHasForm) ENDPROC PROCEDURE Destroy THIS.oShared = null ENDPROC |oshared lruntimer Use if launching modal form with ActiveX control. *addtoproject *oshared_access *cfilename_assign PROCEDURE addtoproject LPARAMETER cPJXName THIS.oShared.AddToProject(this.cFileName,m.cPJXName) ENDPROC PROCEDURE oshared_access IF VARTYPE(THIS.oShared) # "O" THIS.oShared = THIS.oHost.GetObject(OBJ_SHARED) ENDIF RETURN THIS.oShared ENDPROC PROCEDURE cfilename_assign LPARAMETERS vNewVal THIS.cfilename = m.vNewVal THIS.RefreshPicture() ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF THIS.oShared.DragDrop2(oSource, nXCoord, nYCoord, THIS) ENDPROC PROCEDURE run THIS.oShared.Run(THIS) ENDPROC PROCEDURE modify THIS.oShared.Modify(THIS) ENDPROC PROCEDURE setmenu LPARAMETERS toObject LOCAL oProjMenu IF NOT DODEFAULT(toObject) RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF this.AddMenuBar(MENU_MODIFY_LOC,"oTHIS.Modify()",,,,,!this.oHost.lRunFileDefault) this.AddMenuBar(MENU_RUN_LOC,"oTHIS.Run()",,,,!INLIST(UPPER(JUSTEXT(THIS.cFileName)),"PRG","QPR","MPR"),this.oHost.lRunFileDefault) this.AddMenuSeparator oProjMenu = THIS.NewMenu() THIS.oShared.AddProjectMenu(@oProjMenu) this.AddMenuBar(MENU_ADDPROJECT_LOC,oProjMenu,,,,_VFP.PROJECTS.COUNT=0) ENDPROC PROCEDURE dblclick IF NOT DODEFAULT() RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF IF this.oHost.lRunFileDefault this.Run() ELSE this.Modify() ENDIF ENDPROC PROCEDURE Destroy THIS.oShared = null ENDPROC PROCEDURE refreshpicture DO CASE CASE !EMPTY(THIS.cPicture) AND; !INLIST(LOWER(JUSTFNAME(THIS.cPicture)),ICO_PROGRAM,ICO_TEXT) CASE INLIST(UPPER(JUSTEXT(THIS.cFileName)),"PRG","QPR","MPR") THIS.cPicture = ICONFOLDER+ICO_PROGRAM OTHERWISE THIS.cPicture = ICONFOLDER+ICO_TEXT ENDCASE THIS.cPicture = THIS.FullPath(THIS.cPicture) ENDPROC I 00 %Vg6U&C UCPJXNAMETHISOSHARED ADDTOPROJECT CFILENAME$C UCSCXNAMETHISOSHARED ADDTOFORMV%COC+TCVFPGLRY!SHAREDOBJ BUTHISOSHAREDOHOST GETOBJECTV%C /B- CUOSOURCENXCOORDNYCOORDTHISOSHARED CHECKITEM DRAGDROP2CUTHISOSHAREDRUNy%C B-%C 9B-%] Cr CUTHISOSHARED CHECKITEMOHOSTLRUNFILEDEFAULTRUNMODIFYCUTHISOSHAREDMODIFYw%C /B-%C SB-:C Mo\ C (CCC@ program.icotext.ico K) CCCfPRGQPRMPR(T graphics\ program.ico2%T graphics\text.icoTCUTHISCPICTURE CFILENAMEFULLPATH addtoproject,oshared_accesscfilename_assign dragdrop2Zrunmodify#setmenuUdblclick0Destroyrefreshpicture1q3A3q!3qA3A3A2qr"qAqAA13qAqA1A33QA2c e 5Mj"&w62D4 H):yPROCEDURE addcustomclass LPARAMETERS cClasslib,cClass WITH THISFORM IF ALEN(.aUserClasses) = 29 &&total classes DIMENSION .aUserClasses[ALEN(.aUserClasses)+1] ENDIF .aUserClasses[ALEN(.aUserClasses)] = m.cClass .cboClass.RowSource = "THISFORM.aUserClasses" .cboClass.Value = m.cClass .lblFromFile.Caption = m.cClasslib DIMENSION .aCustClasses[2] .aCustClasses[1] = m.cClasslib .aCustClasses[2] = m.cClass ENDWITH ENDPROC PROCEDURE Init PARAMETER oAction IF VARTYPE(oAction)#"O" RETURN .F. ENDIF THISFORM.oAction = oAction WITH THISFORM .oAction.AddProperty("cNewClass") IF VARTYPE(.oAction.cNewClass) = "C" .txtClass.Value = .oAction.cNewClass ENDIF .oAction.AddProperty("cSaveClassLib") IF VARTYPE(.oAction.cSaveClassLib) = "C" .txtClasslib.Value = .oAction.cSaveClassLib ENDIF .oAction.AddProperty("cFromClass") .oAction.AddProperty("cFromClassLib") IF VARTYPE(.oAction.cFromClass) = "C" AND !EMPTY(.oAction.cFromClass) .AddCustomClass(.oAction.cFromClassLib,.oAction.cFromClass) ENDIF ENDWITH IF fontmetric(1, 'MS Sans Serif', 8, '') # 13 OR ; fontmetric(4, 'MS Sans Serif', 8, '') # 2 OR ; fontmetric(6, 'MS Sans Serif', 8, '') # 5 OR ; fontmetric(7, 'MS Sans Serif', 8, '') # 11 this.setall('fontname', 'Arial') ELSE this.setall('fontname','MS Sans Serif') ENDIF this.setall('fontsize',8) ENDPROC ? &&4% @=U)%C B- BCUTHISRUNP%C  B-)C\THIS.oHost.RunCodeTimer([DO FORM "&cCmd" WITH &cTmpParm.]) l.THIS.oHost.RunCodeTimer([DO FORM "&cCmd"]) %C +DO FORM (THIS.cFileName) WITH &cTmpParm < CCCRf.PRG.MPR.QPR.FXP.APP% %C l9THIS.oHost.RunCodeTimer([DO "&cCmd" WITH &cTmpParm.]) )THIS.oHost.RunCodeTimer([DO "&cCmd"]) %C &DO (THIS.cFileName) WITH &cTmpParm   C.EXE.RUN /N "&cCmd" 4 C.FRXC.LBX q?2Copen G( U CHELPFILECSETHELPCTMPPARMCCMDTHISCSCRIPT RUNSCRIPT CFILENAME CPARMBLOCK LRUNTIMEROHOST SHELLEXECUTE DATASESSIONIDdblclick,setmenudrun1qA3q!qA31qA3AAqA!1A1AA1A1aAA!BA"2Om E)& l%-1U  T/%C m.cExtensionbC C > d BT . TC %  B TC C %  B BC U CEXTENSIONCEXTNKEYCAPPKEYLSERVERNERRNUMCOPTNAMETHISOPENKEY GETKEYVALUECLOSEKEYGETAPPLICATION  T!TC \CurVer% j B TC C %  B BC U CCLASSCEXTNKEYCAPPKEYLSERVERNERRNUMCOPTNAMETHISOPENKEY GETKEYVALUECLOSEKEYGETAPPLICATION 4  T&%C m.lServerbL  |/T\Protocol\StdFileEditing\Server#T\Shell\Open\CommandT C %  B TC C B U CEXTNKEYCAPPKEYLSERVERNERRNUMCOPTNAMETHIS CAPPPATHKEYOPENKEY GETKEYVALUECLOSEKEY getapppath,getlatestversiongetapplication13Aas1A2A311A2A3c1A1A2 !8)PROCEDURE addtoproject LPARAMETER cPJXName THIS.oShared.AddToProject(this.cFileName,m.cPJXName) ENDPROC PROCEDURE addtoform LPARAMETER cSCXName THIS.oShared.AddToForm(THIS,m.cSCXName) ENDPROC PROCEDURE oshared_access IF VARTYPE(THIS.oShared) # "O" THIS.oShared = THIS.oHost.GetObject(OBJ_SHARED) ENDIF RETURN THIS.oShared ENDPROC PROCEDURE cfilename_assign LPARAMETERS vNewVal THIS.cfilename = m.vNewVal THIS.RefreshPicture() ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF THIS.oShared.DragDrop2(oSource, nXCoord, nYCoord, THIS) ENDPROC PROCEDURE dblclick IF NOT DODEFAULT() RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF IF this.oHost.lRunFileDefault this.Run() ELSE this.Modify() ENDIF ENDPROC PROCEDURE run THIS.oShared.RUN(THIS) ENDPROC PROCEDURE modify THIS.oShared.Modify(THIS) ENDPROC PROCEDURE setmenu LPARAMETERS toObject LOCAL oProjMenu,oFormMenu,lHasForm IF NOT DODEFAULT(toObject) RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF this.AddMenuBar(MENU_MODIFY_LOC,"oTHIS.Modify()",,,,,!this.oHost.lRunFileDefault) this.AddMenuBar(MENU_PREVIEW_LOC,"oTHIS.Run()",,,,,this.oHost.lRunFileDefault) this.AddMenuSeparator oProjMenu = THIS.NewMenu() THIS.oShared.AddProjectMenu(@oProjMenu) this.AddMenuBar(MENU_ADDPROJECT_LOC,oProjMenu,,,,_VFP.PROJECTS.COUNT=0) oFormMenu = THIS.NewMenu() lHasForm = THIS.oShared.AddFormMenu(@oFormMenu) this.AddMenuBar(MENU_ADDFORM_LOC,oFormMenu,,,,!lHasForm) ENDPROC PROCEDURE Destroy THIS.oShared = null ENDPROC PROCEDURE refreshpicture DO CASE CASE !EMPTY(THIS.cPicture) AND; !INLIST(LOWER(JUSTFNAME(THIS.cPicture)),ICO_LABEL,ICO_REPORT) CASE INLIST(UPPER(JUSTEXT(THIS.cFileName)),"LBX") THIS.cPicture = ICONFOLDER+ICO_LABEL OTHERWISE THIS.cPicture = ICONFOLDER+ICO_REPORT ENDCASE THIS.cPicture = THIS.FullPath(THIS.cPicture) ENDPROC I 00%0+qU  %C` 8BTCCf%C FORM rBTUAFRMOBJCOBJBASE BASECLASSSHOWPICTURETHIS CFILENAMEC%C  B-  TC` CCSet VFP Wallpaper_screen.Picture=oTHIS.cFilename%C9 8CClear VFP Wallpaper_screen.Picture='' FCSet Form \ adddataenvcfilename_assigncviewname_assignk dragdrop2setmenuG dblclick modifyWrunDestroyrefreshpicture13333qqq1AA3a3AA!3q3A3A3qAABBA1"AAAA1!AAAAAA3q!2q!2qqAAACr1AA3q"qAqA"A11QA3qAqA1A3qqA!QAAA!A3qqAaAA321QaA2Jk N ni! R.#w3( v:- AY 2 {]Y a r z@] 0D)PROCEDURE addtoform LPARAMETER cSCXName LOCAL oNewObj oNewObj=THIS.oShared.AddToForm(THIS,m.cSCXName) IF VARTYPE(m.oNewObj)="O" WITH oNewObj .Caption = this.cText .AutoSize = .T. .cTarget = this.cFileName ENDWITH ENDIF ENDPROC PROCEDURE oshared_access IF VARTYPE(THIS.oShared) # "O" THIS.oShared = THIS.oHost.GetObject(OBJ_SHARED) ENDIF RETURN THIS.oShared ENDPROC PROCEDURE cfilename_assign LPARAMETERS vNewVal THIS.cfilename = m.vNewVal THIS.RefreshPicture() ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord LOCAL oNewObj oNewObj=THIS.oShared.DragDrop2(oSource,nXCoord,nYCoord,THIS) IF VARTYPE(m.oNewObj)="O" WITH oNewObj .Caption = this.cText .AutoSize = .T. .cTarget = this.cFileName ENDWITH ENDIF ENDPROC PROCEDURE setmenu LPARAMETERS toObject IF NOT DODEFAULT(toObject) RETURN .F. ENDIF LOCAL lHasForm this.AddMenuBar(MENU_OPEN_LOC,"oTHIS.Run()",,,,,.T.) this.AddMenuSeparator oFormMenu = THIS.NewMenu() lHasForm = THIS.oShared.AddFormMenu(@oFormMenu) this.AddMenuBar(MENU_ADDHYPER_LOC,oFormMenu,,,,!lHasForm) ENDPROC PROCEDURE run LOCAL lcURL, oUtils, nErr IF NOT DODEFAULT() RETURN .F. ENDIF lcURL = this.cFileName IF EMPTY(m.lcURL) RETURN .F. ENDIF nErr = this.oHost.ShellExecute(m.lcURL) RETURN m.nErr>31 ENDPROC PROCEDURE dblclick IF NOT DODEFAULT() RETURN .F. ENDIF this.Run() ENDPROC PROCEDURE Destroy THIS.oShared = null ENDPROC PROCEDURE refreshpicture LOCAL cExt cExt = UPPER(JUSTEXT(THIS.cFileName)) DO CASE CASE !EMPTY(THIS.cPicture) AND; !INLIST(LOWER(JUSTFNAME(THIS.cPicture)),ICO_WEBFILE,ICO_WEBDOC,ICO_WEBSITE) CASE ATC("http://",THIS.cFileName)#0 THIS.cPicture = ICONFOLDER+ICO_WEBSITE CASE INLIST(m.cExt,"ASP","HTM","HTML") THIS.cPicture = ICONFOLDER+ICO_WEBFILE CASE m.cExt="APP" THIS.cPicture = ICONFOLDER+ICO_WEBDOC OTHERWISE THIS.cPicture = ICONFOLDER+ICO_WEBSITE ENDCASE THIS.cPicture = THIS.FullPath(THIS.cPicture) ENDPROC PROCEDURE shellexec * WinApi :: ShellExecute ********************************* *** Function: Opens a file in the application that it's *** associated with. *** Pass: lcFileName - Name of the file to open *** *** Return: 2 - Bad Association (e.g., invalid URL) *** 31 - No application association *** 29 - Failure to load application *** 30 - Application is busy *** *** Values over 32 indicate success *** and return an instance handle for *** the application started (the browser) ************************************************************************ LPARAMETERS lcFileName, lcWorkDir, lcOperation lcWorkDir=IIF(type("m.lcWorkDir")="C",m.lcWorkDir,"") &&can be SYS(2023) lcOperation=IIF(type("m.lcOperation")="C" AND !EMPTY(m.lcOperation),m.lcOperation,"Open") *-* HINSTANCE ShellExecute(hwnd, lpszOp, lpszFile, lpszParams, lpszDir, wShowCmd) *-* *-* HWND hwnd; /* handle of parent window */ *-* LPCTSTR lpszOp; /* address of string for operation to perform */ *-* LPCTSTR lpszFile; /* address of string for filename */ *-* LPTSTR lpszParams; /* address of string for executable-file parameters */ *-* LPCTSTR lpszDir; /* address of string for default directory */ *-* INT wShowCmd; /* whether file is shown when opened */ DECLARE INTEGER ShellExecute ; IN SHELL32.DLL ; INTEGER nWinHandle,; STRING cOperation,; STRING cFileName,; STRING cParameters,; STRING cDirectory,; INTEGER nShowWindow RETURN ShellExecute(0,m.lcOperation,m.lcFilename,"",m.lcWorkDir,1) ENDPROC PROCEDURE autowizard LPARAMETER cWizard,cWizFile LOCAL nSaveArea, cFileDatabase IF VARTYPE(m.cWizard)#"C" OR EMPTY(m.cWizard) RETURN .F. ENDIF THIS.cOutFile = "" THIS.cProjectName = "" SET DATASESSION TO 1 nSaveArea = SELECT() DO CASE CASE VARTYPE(m.cWizFile)="C" AND !FILE(m.cWizFile) THIS.lRunWizard = .F. CASE VARTYPE(m.cWizFile)="C" IF THIS.OpenData(m.cWizFile) THIS.cWizAlias = ALIAS() ELSE THIS.lRunWizard = .F. ENDIF OTHERWISE THIS.lRunWizard = .F. oData = NewObject(DATAPICKER_CLASS,HOME()+VFPGLRY_VCX) oData.oWizStyle = THIS oData.Show IF EMPTY(THIS.aWizFields) THIS.lBlankform = .T. ENDIF ENDCASE IF THIS.lRunWizard DO CASE CASE ATC("FORM",m.cWizard) # 0 THIS.nWizAction = 3 DO (_WIZARD) WITH "AUTOFORM","","",THIS CASE ATC("REPORT",m.cWizard) # 0 THIS.nWizAction = 2 DO (_WIZARD) WITH "AUTOREPORT","","",THIS ENDCASE ENDIF SELECT (m.nSaveArea) SET DATASESSION TO (_oBrowser.DataSessionID) * Reset properties THIS.SaveSets() IF !EMPTY(THIS.cOutFile) AND FILE(THIS.cOutFile) IF THIS.lFavorites oCatalog = _oBrowser.GetFolder("favorites") IF !ISNULL(oCatalog) oNode=_oBrowser.CreateNode(oCatalog,"_FileItem",THIS.cOutFile,.T.) ENDIF ENDIF IF !EMPTY(THIS.cProjectName) _VFP.Projects(THIS.cProjectName).Files.Add(THIS.cOutFile) ENDIF ENDIF ENDPROC PROCEDURE savesets * Reset properties DIMENSION THIS.aWizFields[1,1] DIMENSION THIS.aWizSorts[1,1] DIMENSION THIS.aWizStyles[2,2] THIS.cWizAlias = "" STORE "" TO THIS.aWizFields,THIS.aWizSorts,THIS.aWizStyles THIS.lBlankform = .F. ENDPROC PROCEDURE opendata LPARAMETER cDataSource,cViewName,lExclusive,nDataSession LOCAL cEXCL IF EMPTY(m.cDataSource) OR TYPE("m.cDataSource")#"C" OR !FILE(m.cDataSource) RETURN .F. ENDIF IF TYPE("m.lExclusive")#"L" m.lExclusive = .F. ENDIF cEXCL = IIF(m.lExclusive,"EXCLUSIVE","SHARED") * Ensure we have datasession set IF TYPE("m.nDataSession")#"N" SET DATASESSION TO 1 ENDIF * Assume we have a view IF !EMPTY(m.cViewName) OPEN DATA (m.cDataSource) USE (m.cViewName) AGAIN &cEXCL. ELSE IF USED(JUSTSTEM(m.cDataSource)) SELECT (JUSTSTEM(m.cDataSource)) IF !ISEXCLUSIVE() AND m.lExclusive USE (m.cDataSource) AGAIN &cEXCL. ENDIF ELSE SELECT 0 USE (m.cDataSource) AGAIN &cEXCL. ENDIF ENDIF IF EMPTY(ALIAS()) RETURN .F. ENDIF ENDPROC PROCEDURE runwizard LPARAMETER cWizName,cWizFile LOCAL nSaveArea, cFileDatabase THIS.lRunWizard=.F. SET DATASESSION TO 1 nSaveArea = SELECT() IF THIS.OpenData(m.cWizFile) THIS.lRunWizard=.T. ENDIF IF THIS.lRunWizard IF !EMPTY(m.cWizName) DO (_WIZARD) WITH m.cWizName ELSE DO (_WIZARD) ENDIF ENDIF SELECT (m.nSaveArea) SET DATASESSION TO (_oBrowser.DataSessionID) ENDPROC PROCEDURE autoapp LPARAMETER cTemplate,nProjectType LOCAL oProj, oCatalog, oNode LOCAL lcHookFile, lcHookClass IF VARTYPE(m.nProjectType)#"N" THIS.nProjectType=IIF(FILE(HOME()+"WIZARDS\_FRAMEWK.DBF"),3,2) ELSE THIS.nProjectType = m.nProjectType ENDIF IF !EMPTY(m.cTemplate) THIS.nProjectType = 1 THIS.nDatabaseType = 2 THIS.cDatabaseTemplate = m.cTemplate ELSE THIS.nDatabaseType = 1 THIS.cDatabaseTemplate = "" ENDIF THIS.lRunWizard = .F. oProj = NewObject(PROJPICKER_CLASS,HOME()+VFPGLRY_VCX) oProj.oWizStyle = THIS oProj.Show IF !THIS.lRunWizard OR EMPTY(THIS.cOutFile) OR EMPTY(THIS.cProjectName) RETURN ENDIF DO HOME()+"WIZARDS\WZAPP.APP" WITH "","",THIS IF FILE(THIS.cOutFile) IF THIS.lFavorites oCatalog = _oBrowser.GetFolder("favorites") IF ISNULL(oCatalog) RETURN ENDIF oNode=_oBrowser.CreateNode(oCatalog,"_FileItem",THIS.cOutFile,.T.) ENDIF _VFP.Projects[THIS.cOutFile].Build(FORCEEXT(THIS.cOutFile,"APP"),2) MODIFY PROJECT (THIS.cOutFile) NOWAIT * setup project hooks IF THIS.nDatabaseType=1 AND FILE(HOME()+"WIZARDS\"+APPHOOK_FILE) lcHookFile = HOME()+"WIZARDS\"+APPHOOK_FILE lcHookClass = APPHOOK_CLASS _VFP.Projects[THIS.cOutFile].ProjectHookLibrary = lcHookFile _VFP.Projects[THIS.cOutFile].ProjectHookClass = lcHookClass _VFP.Projects[THIS.cOutFile].Close MODIFY PROJECT (THIS.cOutFile) NOWAIT _SHELL = [DO (_WIZARD) WITH "Project",,,.T.] ENDIF ENDIF ENDPROC PROCEDURE Destroy THIS.RestoreSets ENDPROC PROCEDURE Init THIS.SaveSets() ENDPROC  x=%UU     %x B%| RegOpenKeyWin32API% B'| RegCreateKeyWin32API$| RegDeleteKeyWin32API%|RegDeleteValueWin32API | RegCloseKeyWin32API,| RegSetValueExWin32API1|RegQueryValueExWin32API'| RegEnumKeyWin32API4| RegEnumKeyExWin32API4| RegEnumValueWin32APITa BU"NHKEYCSUBKEYNRESULTHKEYIVALUE LPSZVALUE LPCCHVALUELPDWTYPELPBDATALPCBDATALPCSTRLPSZVALNLEN LPDWRESERVED LPSZVALUENAME DWRESERVEDFDWTYPEISUBKEYLPSZNAMECCHNAMETHIS LLOADEDDLLS REGOPENKEYWIN32API LHADERROR REGCREATEKEY REGDELETEKEYREGDELETEVALUE REGCLOSEKEY REGSETVALUEEXREGQUERYVALUEEX REGENUMKEY REGENUMKEYEX REGENUMVALUE T TC(%C m.nRegKeybNC  zT  TC%  B T-% C m.lCreateKeybL T %2TC   XTC   T % B T   BU CLOOKUPKEYNREGKEY LCREATEKEYNSUBKEYNERRCODENPCOUNTLSAVECREATEKEYTHIS LOADREGFUNCS REGCREATEKEY REGOPENKEY NCURRENTKEY#CTU REGCLOSEKEYTHIS NCURRENTKEY T T TT C   %  B TC  C B U COPTNAMECOPTVALCKEYPATHNUSERKEYIPOSCOPTKEYCOPTIONNERRNUMTHISOPENKEY SETKEYVALUECLOSEKEY T T TT C   %  B TC C B U COPTNAMECOPTVALCKEYPATHNUSERKEYIPOSCOPTKEYCOPTIONNERRNUMTHISOPENKEY GETKEYVALUECLOSEKEYs J(JCX(JC >(  Hc2 CTHIS.nCurrentKeybN   B C m.cValueNamebC B.T C  %  B  %   G BT C  = BU CVALUENAME CKEYVALUE LPDWRESERVEDLPDWTYPELPBDATALPCBDATANERRCODETHIS NCURRENTKEYREGQUERYVALUEEXK   H#2 CTHIS.nCurrentKeybN  _ B6 C m.cValueNamebCCm.cValuebC  B C C   BT C TC >.T C   % ; B  BU CVALUENAMECVALUE NVALUESIZENERRCODETHIS NCURRENTKEY REGSETVALUEEXI  TT C  B UNUSERKEYCKEYPATHNERRNUM REGDELETEKEY& T T T)%C C m.lEnumKeysbL  T-T C   %  B % TC TC  C B U AREGOPTSCOPTPATHNUSERKEY LENUMKEYSIPOSCOPTKEYCOPTIONNERRNUMTHISOPENKEYENUMKEYS ENUMKEYVALUESCLOSEKEY^ TC % H CB UCKEYNAMENREGKEYNERRNUMTHISOPENKEYCLOSEKEY4 T  +a TTCdXTC >TCdXTC >TCdX3T C  H ! !TC TC C >=%CC lCTC T !%   T  B U AKEYNAMES NKEYENTRYCNEWKEYCNEWSIZECBUFNBUFLENCRETTIMENKEYSIZENERRCODE REGENUMKEYEXTHIS NCURRENTKEY J(2%CTHIS.nCurrentKeybN  } B%  B +aJ(JCX(JC>( JC>( 4TC   H;j S! j!T  $T C  = H (T C  = 4#T *Binary* m(T C  =2)T *Unknown type*!%   T  B U AKEYVALUES LPSZVALUE LPCCHVALUE LPDWRESERVEDLPDWTYPELPBDATALPCBDATANERRCODE NKEYENTRY LARRAYPASSEDTHIS NCURRENTKEY NCURRENTOS REGENUMVALUE  T TT C  % q B T C  C B U COPTNAMECKEYPATHNUSERKEYCOPTIONNERRNUMTHISOPENKEYREGDELETEVALUE NCURRENTKEYCLOSEKEYT JT Software\Microsoft\VisualFoxPro\C\Options\OLEList Hj 24 3 B-! C Windows 3CJT1 C Windows NTCJ CCJg MTT ADVAPI32.DLLT KERNEL32.DLLT ODBC32.DLL2TT ADVAPI32.DLLT KERNEL32.DLLT ODBC32.DLLUTHISNUSERKEY CVFPOPTPATHVERSION NCURRENTOS CREGDLLFILE CINIDLLFILE CODBCDLLFILE+Ta CCExUNERRORCMETHODNLINETHIS LHADERROR loadregfuncs,openkeyclosekey2 setregkeyy getregkey getkeyvalue setkeyvalue deletekeyg enumoptions iskeyenumkeys enumkeyvaluesxdeletekeyvalueInitError411ASAsCSsDE32qA1A!AA"A"33511A3511A3r1!A3AA3!aAS3A3q321A1ARRA31A3q2AA1AAAAA1AA3r"ACARACAA1AA2SA2AAA21A31qA32 :43 c7 iD )QKfx`~2,Ko]#:#$v%`'|'')'PROCEDURE loadregfuncs * Loads funtions needed for Registry LOCAL nHKey,cSubKey,nResult LOCAL hKey,iValue,lpszValue,lpcchValue,lpdwType,lpbData,lpcbData LOCAL lpcStr,lpszVal,nLen,lpdwReserved LOCAL lpszValueName,dwReserved,fdwType LOCAL iSubKey,lpszName,cchName IF THIS.lLoadedDLLs RETURN ERROR_SUCCESS ENDIF DECLARE Integer RegOpenKey IN Win32API ; Integer nHKey, String @cSubKey, Integer @nResult IF THIS.lhaderror && error loading library RETURN -1 ENDIF DECLARE Integer RegCreateKey IN Win32API ; Integer nHKey, String @cSubKey, Integer @nResult DECLARE Integer RegDeleteKey IN Win32API ; Integer nHKey, String @cSubKey DECLARE Integer RegDeleteValue IN Win32API ; Integer nHKey, String cSubKey DECLARE Integer RegCloseKey IN Win32API ; Integer nHKey DECLARE Integer RegSetValueEx IN Win32API ; Integer hKey, String lpszValueName, Integer dwReserved,; Integer fdwType, String lpbData, Integer cbData DECLARE Integer RegQueryValueEx IN Win32API ; Integer nHKey, String lpszValueName, Integer dwReserved,; Integer @lpdwType, String @lpbData, Integer @lpcbData DECLARE Integer RegEnumKey IN Win32API ; Integer nHKey,Integer iSubKey, String @lpszName, Integer @cchName DECLARE Integer RegEnumKeyEx IN Win32API ; Integer nHKey,Integer iSubKey, String @lpszName, Integer @cchName,; Integer dwReserved,String @lpszName, Integer @cchName,String @cchName DECLARE Integer RegEnumValue IN Win32API ; Integer hKey, Integer iValue, String @lpszValue, ; Integer @lpcchValue, Integer lpdwReserved, Integer @lpdwType, ; String @lpbData, Integer @lpcbData THIS.lLoadedDLLs = .T. * Need error check here RETURN ERROR_SUCCESS ENDPROC PROCEDURE openkey * Opens a registry key LPARAMETER cLookUpKey,nRegKey,lCreateKey LOCAL nSubKey,nErrCode,nPCount,lSaveCreateKey nSubKey = 0 nPCount = PARAMETERS() IF TYPE("m.nRegKey") # "N" OR EMPTY(m.nRegKey) m.nRegKey = HKEY_CLASSES_ROOT ENDIF * Load API functions nErrCode = THIS.LoadRegFuncs() IF m.nErrCode # ERROR_SUCCESS RETURN m.nErrCode ENDIF lSaveCreateKey = THIS.lCreateKey IF m.nPCount>2 AND TYPE("m.lCreateKey") = "L" THIS.lCreateKey = m.lCreateKey ENDIF IF THIS.lCreateKey * Try to open or create registry key nErrCode = RegCreateKey(m.nRegKey,m.cLookUpKey,@nSubKey) ELSE * Try to open registry key nErrCode = RegOpenKey(m.nRegKey,m.cLookUpKey,@nSubKey) ENDIF THIS.lCreateKey = m.lSaveCreateKey IF nErrCode # ERROR_SUCCESS RETURN m.nErrCode ENDIF THIS.nCurrentKey = m.nSubKey RETURN ERROR_SUCCESS ENDPROC PROCEDURE closekey * Closes a registry key =RegCloseKey(THIS.nCurrentKey) THIS.nCurrentKey =0 ENDPROC PROCEDURE setregkey * This routine sets a registry key setting * ex. THIS.SetRegKey("ResWidth","640",; * "Software\Microsoft\VisualFoxPro\4.0\Options",; * HKEY_CURRENT_USER) LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey LOCAL iPos,cOptKey,cOption,nErrNum iPos = 0 cOption = "" nErrNum = ERROR_SUCCESS * Open registry key m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Set Key value nErrNum = THIS.SetKeyValue(m.cOptName,m.cOptVal) * Close registry key THIS.CloseKey() &&close key RETURN m.nErrNum ENDPROC PROCEDURE getregkey * This routine gets a registry key setting * ex. THIS.GetRegKey("ResWidth",@cValue,; * "Software\Microsoft\VisualFoxPro\4.0\Options",; * HKEY_CURRENT_USER) LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey LOCAL iPos,cOptKey,cOption,nErrNum iPos = 0 cOption = "" nErrNum = ERROR_SUCCESS * Open registry key m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Get the key value nErrNum = THIS.GetKeyValue(cOptName,@cOptVal) * Close registry key THIS.CloseKey() &&close key RETURN m.nErrNum ENDPROC PROCEDURE getkeyvalue * Obtains a value from a registry key * Note: this routine only handles Data strings (REG_SZ) LPARAMETER cValueName,cKeyValue LOCAL lpdwReserved,lpdwType,lpbData,lpcbData,nErrCode STORE 0 TO lpdwReserved,lpdwType STORE SPACE(256) TO lpbData STORE LEN(m.lpbData) TO m.lpcbData DO CASE CASE TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0 RETURN ERROR_BADKEY CASE TYPE("m.cValueName") #"C" RETURN ERROR_BADPARM ENDCASE m.nErrCode=RegQueryValueEx(THIS.nCurrentKey,m.cValueName,; m.lpdwReserved,@lpdwType,@lpbData,@lpcbData) * Check for error IF m.nErrCode # ERROR_SUCCESS RETURN m.nErrCode ENDIF * Make sure we have a data string data type IF m.lpdwType # REG_SZ AND m.lpdwType # REG_EXPAND_SZ RETURN ERROR_NONSTR_DATA ENDIF m.cKeyValue = LEFT(m.lpbData,m.lpcbData-1) RETURN ERROR_SUCCESS ENDPROC PROCEDURE setkeyvalue * This routine sets a key value * Note: this routine only handles data strings (REG_SZ) LPARAMETER cValueName,cValue LOCAL nValueSize,nErrCode DO CASE CASE TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0 RETURN ERROR_BADKEY CASE TYPE("m.cValueName") #"C" OR TYPE("m.cValue")#"C" RETURN ERROR_BADPARM CASE EMPTY(m.cValueName) OR EMPTY(m.cValue) RETURN ERROR_BADPARM ENDCASE * Make sure we null terminate this guy cValue = m.cValue+CHR(0) nValueSize = LEN(m.cValue) * Set the key value here m.nErrCode = RegSetValueEx(THIS.nCurrentKey,m.cValueName,0,; REG_SZ,m.cValue,m.nValueSize) * Check for error IF m.nErrCode # ERROR_SUCCESS RETURN m.nErrCode ENDIF RETURN ERROR_SUCCESS ENDPROC PROCEDURE deletekey * This routine deletes a Registry Key LPARAMETER nUserKey,cKeyPath LOCAL nErrNum nErrNum = ERROR_SUCCESS * Delete key m.nErrNum = RegDeleteKey(m.nUserKey,m.cKeyPath) RETURN m.nErrNum ENDPROC PROCEDURE enumoptions * Enumerates through all entries for a key and populates array LPARAMETER aRegOpts,cOptPath,nUserKey,lEnumKeys LOCAL iPos,cOptKey,cOption,nErrNum iPos = 0 cOption = "" nErrNum = ERROR_SUCCESS IF PARAMETERS()<4 OR TYPE("m.lEnumKeys") # "L" lEnumKeys = .F. ENDIF * Open key m.nErrNum = THIS.OpenKey(m.cOptPath,m.nUserKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Enumerate through keys IF m.lEnumKeys * Enumerate and get key names nErrNum = THIS.EnumKeys(@aRegOpts) ELSE * Enumerate and get all key values nErrNum = THIS.EnumKeyValues(@aRegOpts) ENDIF * Close key THIS.CloseKey() &&close key RETURN m.nErrNum ENDPROC PROCEDURE iskey * Checks to see if a key exists LPARAMETER cKeyName,nRegKey * Open extension key nErrNum = THIS.OpenKey(m.cKeyName,m.nRegKey) IF m.nErrNum = ERROR_SUCCESS * Close extension key THIS.CloseKey() ENDIF RETURN m.nErrNum = ERROR_SUCCESS ENDPROC PROCEDURE enumkeys PARAMETER aKeyNames LOCAL nKeyEntry,cNewKey,cNewSize,cbuf,nbuflen,cRetTime nKeyEntry = 0 DIMENSION aKeyNames[1] DO WHILE .T. nKeySize = 0 cNewKey = SPACE(100) nKeySize = LEN(m.cNewKey) cbuf=space(100) nbuflen=len(m.cbuf) cRetTime=space(100) m.nErrCode = RegEnumKeyEx(THIS.nCurrentKey,m.nKeyEntry,@cNewKey,@nKeySize,0,@cbuf,@nbuflen,@cRetTime) DO CASE CASE m.nErrCode = ERROR_EOF EXIT CASE m.nErrCode # ERROR_SUCCESS EXIT ENDCASE cNewKey = ALLTRIM(m.cNewKey) cNewKey = LEFT(m.cNewKey,LEN(m.cNewKey)-1) IF !EMPTY(aKeyNames[1]) DIMENSION aKeyNames[ALEN(aKeyNames)+1] ENDIF aKeyNames[ALEN(aKeyNames)] = m.cNewKey nKeyEntry = m.nKeyEntry + 1 ENDDO IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0 m.nErrCode = ERROR_SUCCESS ENDIF RETURN m.nErrCode ENDPROC PROCEDURE enumkeyvalues * Enumerates through values of a registry key LPARAMETER aKeyValues LOCAL lpszValue,lpcchValue,lpdwReserved LOCAL lpdwType,lpbData,lpcbData LOCAL nErrCode,nKeyEntry,lArrayPassed STORE 0 TO nKeyEntry IF TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0 RETURN ERROR_BADKEY ENDIF * Sorry, Win32s does not support this one! IF THIS.nCurrentOS = OS_W32S RETURN ERROR_BADPLAT ENDIF DO WHILE .T. STORE 0 TO lpdwReserved,lpdwType,nErrCode STORE SPACE(256) TO lpbData, lpszValue STORE LEN(lpbData) TO m.lpcchValue STORE LEN(lpszValue) TO m.lpcbData nErrCode=RegEnumValue(THIS.nCurrentKey,m.nKeyEntry,@lpszValue,; @lpcchValue,m.lpdwReserved,@lpdwType,@lpbData,@lpcbData) DO CASE CASE m.nErrCode = ERROR_EOF EXIT CASE m.nErrCode # ERROR_SUCCESS EXIT ENDCASE nKeyEntry = m.nKeyEntry + 1 * Set array values DIMENSION aKeyValues[m.nKeyEntry,2] aKeyValues[m.nKeyEntry,1] = LEFT(m.lpszValue,m.lpcchValue) DO CASE CASE lpdwType = REG_SZ aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1) CASE lpdwType = REG_BINARY * Don't support binary aKeyValues[m.nKeyEntry,2] = REG_BINARY_LOC CASE lpdwType = REG_DWORD * You will need to use ASC() to check values here. aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1) OTHERWISE aKeyValues[m.nKeyEntry,2] = REG_UNKNOWN_LOC ENDCASE ENDDO IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0 m.nErrCode = ERROR_SUCCESS ENDIF RETURN m.nErrCode ENDPROC PROCEDURE deletekeyvalue LPARAMETER cOptName,cKeyPath,nUserKey LOCAL cOption,nErrNum cOption = cOptName nErrNum = ERROR_SUCCESS * Open key m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Delete the key value m.nErrNum = RegDeleteValue(THIS.nCurrentKey,m.cOption) * Close key THIS.CloseKey() && close key RETURN m.nErrNum ENDPROC PROCEDURE Init THIS.nUserKey = HKEY_CURRENT_USER THIS.cVFPOptPath = VFP_OPTIONS_KEY1 + _VFP.VERSION + VFP_OPTIONS_KEY2 DO CASE CASE _DOS OR _UNIX OR _MAC RETURN .F. CASE ATC("Windows 3",OS(1)) # 0 THIS.nCurrentOS = OS_W32S CASE ATC("Windows NT",OS(1)) # 0 OR VAL(OS(3))>=5 THIS.nCurrentOS = OS_NT THIS.cRegDLLFile = DLL_ADVAPI_NT THIS.cINIDLLFile = DLL_KERNEL_NT THIS.cODBCDLLFile = DLL_ODBC_NT OTHERWISE * Windows 95 THIS.nCurrentOS = OS_WIN95 THIS.cRegDLLFile = DLL_ADVAPI_WIN95 THIS.cINIDLLFile = DLL_KERNEL_WIN95 THIS.cODBCDLLFile = DLL_ODBC_WIN95 ENDCASE ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.lhaderror = .T. =MESSAGEBOX(MESSAGE()) ENDPROC cbaseclass something csamplefile sdfsdf oshared citemhelpfile vhelpitem *viewsample *addtoform *addtoproject *cbaseclass_access *opensample *viewbrowser *createform *cclass_assign *oshared_access *locatesample *addtopath OPROCEDURE autoform RETURN THIS.oUtils.AutoWizard("FORM",this.cFileName) ENDPROC PROCEDURE autoreport RETURN THIS.oUtils.AutoWizard("REPORT",this.cFileName) ENDPROC PROCEDURE makepivot RETURN THIS.oUtils.RunWizard("PIVOT",this.cFileName) ENDPROC PROCEDURE mailmerge RETURN THIS.oUtils.RunWizard("MAIL",this.cFileName) ENDPROC PROCEDURE addtoform LPARAMETER cSCXName LOCAL oNewObj oNewObj=THIS.oShared.AddToForm(THIS,m.cSCXName) IF VARTYPE(m.oNewObj)="O" IF THIS.oUtils.OpenData(this.cFileName) AND !EMPTY(ALIAS()) oNewObj.recordsource = ALIAS() THIS.AddDataEnv(oNewObj) ENDIF ENDIF ENDPROC PROCEDURE isview RETURN (!EMPTY(THIS.cViewName) AND UPPER(JUSTEXT(THIS.cFileName))="DBC") ENDPROC PROCEDURE makehtml LOCAL m.nSaveArea nSaveArea = SELECT() SET DATASESSION TO 1 IF THIS.oUtils.OpenData(this.cFileName) IF !EMPTY(ALIAS()) DO (_GENHTML) WITH "",ALIAS(),2 ENDIF ENDIF SELECT (m.nSaveArea) SET DATASESSION TO (THIS.oHost.DataSessionID) ENDPROC PROCEDURE addtoproject LPARAMETER cPJXName THIS.oShared.AddToProject(this.cFileName,m.cPJXName) ENDPROC PROCEDURE oshared_access IF VARTYPE(THIS.oShared) # "O" THIS.oShared = THIS.oHost.GetObject(OBJ_SHARED) ENDIF RETURN THIS.oShared ENDPROC PROCEDURE outils_access IF VARTYPE(THIS.oUtils) # "O" THIS.oUtils = THIS.oHost.GetObject(OBJ_GLRYUTIL) ENDIF RETURN THIS.oUtils ENDPROC PROCEDURE adddataenv LPARAMETERS oSource * Set DataEnvironment * Check if in designer IF EMPTY(ALIAS()) RETURN ENDIF LOCAL oForm,oDataEnvRef,aDataEnv,nInc,cNewName,cDataBase,cSourceName DIMENSION aDataEnv[1] oForm = oSource.Parent cDatabase = LOWER(CURSORGETPROP("DATABASE")) cSourceName = LOWER(CURSORGETPROP("SOURCENAME")) DO WHILE TYPE("oForm") = "O" AND !ISNULL(oForm) IF PEMSTATUS(oForm,"ShowWindow",5) IF !PEMSTATUS(oForm,"ShowWindow",1) * In design mode IF ASELOBJ(aDataEnv,2) = 0 * In Class Designer, not Form Designer EXIT ENDIF oDataEnvRef = aDataEnv[1] * Add Cursor record nInc = "1" DO WHILE TYPE("oDataEnvRef.Cursor"+m.nInc) # "U" * Check if cursor already exists cNewName = "Cursor"+m.nInc WITH oDataEnvRef.&cNewName. IF .CursorSource == m.cSourceName AND; .Database == m.cDatabase oForm = "" RETURN ENDIF ENDWITH m.nInc = ALLTRIM(STR(VAL(m.nInc)+1)) ENDDO cNewName = "Cursor"+m.nInc oDataEnvRef.ADDOBJECT(m.cNewName,"cursor") WITH oDataEnvRef.&cNewName. .Alias = LOWER(ALIAS()) .CursorSource = m.cSourceName IF !EMPTY(m.cDatabase) .Database = m.cDatabase ENDIF ENDWITH ENDIF EXIT ENDIF oForm = oForm.Parent ENDDO oForm = "" oDataEnvRef = "" ENDPROC PROCEDURE cfilename_assign LPARAMETERS vNewVal THIS.cfilename = m.vNewVal THIS.RefreshPicture() ENDPROC PROCEDURE cviewname_assign LPARAMETERS vNewVal THIS.cviewname = m.vNewVal THIS.RefreshPicture() ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord LOCAL oNewObj IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF IF THIS.IsView() RETURN ENDIF * Add Grid object to form oNewObj=THIS.oShared.DragDrop2(oSource, nXCoord, nYCoord, THIS) IF VARTYPE(m.oNewObj)="O" SET DATASESSION TO oSource.DataSessionID IF THIS.oUtils.OpenData(this.cFileName) AND !EMPTY(ALIAS()) oNewObj.recordsource = ALIAS() THIS.AddDataEnv(oNewObj) ENDIF ENDIF ENDPROC PROCEDURE setmenu LPARAMETERS toObject IF NOT DODEFAULT(toObject) RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF LOCAL lHasForm,oProjMenu,oFormMenu this.AddMenuBar(MENU_BROWSER_LOC,"oTHIS.Run",,,,,this.oHost.lRunFileDefault) this.AddMenuBar(MENU_MODIFY_LOC,"oTHIS.Modify",,,,,!this.oHost.lRunFileDefault) IF !THIS.ISVIEW() this.AddMenuSeparator oFormMenu = THIS.NewMenu() lHasForm = THIS.oShared.AddFormMenu(@oFormMenu) this.AddMenuBar(MENU_ADDFORM_LOC,oFormMenu,,,,!lHasForm) oProjMenu = THIS.NewMenu() THIS.oShared.AddProjectMenu(@oProjMenu) this.AddMenuBar(MENU_ADDPROJECT_LOC,oProjMenu,,,,_VFP.PROJECTS.COUNT=0) this.AddMenuSeparator this.AddMenuBar(MENU_QUICKFORM_LOC,"oTHIS.AutoForm") this.AddMenuBar(MENU_QUICKREPORT_LOC,"oTHIS.AutoReport") this.AddMenuSeparator this.AddMenuBar(MENU_MAILMERGE_LOC,"oTHIS.MailMerge") this.AddMenuBar(MENU_PIVOT_LOC,"oTHIS.MakePivot") this.AddMenuBar(MENU_OUTHTML_LOC,"oTHIS.MakeHTML") ENDIF ENDPROC PROCEDURE dblclick IF NOT DODEFAULT() RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF IF this.oHost.lRunFileDefault this.Run() ELSE this.Modify() ENDIF ENDPROC PROCEDURE modify LOCAL nSaveArea IF NOT DODEFAULT() OR NOT THIS.lModify RETURN .F. ENDIF IF !EMPTY(THIS.cFileName) AND FILE(this.cFileName) nSaveArea = SELECT() SELECT 0 IF !THIS.ISVIEW() IF THIS.oUtils.OpenData(this.cFileName,"",.T.) SET DATASESSION TO 1 MODIFY STRUCTURE ENDIF ELSE SET DATASESSION TO 1 OPEN DATA (this.cFileName) IF DBGETPROP(this.cViewName,"view","sourcetype")=1 &&Local View MODIFY VIEW (this.cViewName) ELSE MODIFY VIEW (this.cViewName) REMOTE ENDIF ENDIF SELECT (m.nSaveArea) SET DATASESSION TO (this.oHost.DataSessionID) ENDIF ENDPROC PROCEDURE run LOCAL nSaveArea IF NOT DODEFAULT() RETURN .F. ENDIF IF !EMPTY(THIS.cFileName) AND FILE(this.cFileName) nSaveArea = SELECT() IF THIS.oUtils.OpenData(this.cFileName,this.cViewName) SET DATASESSION TO 1 BROWSE NORMAL NOWAIT ENDIF ENDIF ENDPROC PROCEDURE Destroy THIS.oShared = null THIS.oUtils = null ENDPROC PROCEDURE refreshpicture DO CASE CASE !EMPTY(THIS.cPicture) AND; !INLIST(LOWER(JUSTFNAME(THIS.cPicture)),ICO_VIEW,ICO_TABLE) CASE !EMPTY(THIS.cViewName) THIS.cPicture = ICONFOLDER+ICO_VIEW OTHERWISE THIS.cPicture = ICONFOLDER+ICO_TABLE ENDCASE THIS.cPicture = THIS.FullPath(THIS.cPicture) ENDPROC    %>LUTC %C O ~T TaT U CSCXNAMEONEWOBJTHISOSHARED ADDTOFORMCAPTIONCTEXTAUTOSIZECTARGET CFILENAMEV%COC+TCVFPGLRY!SHAREDOBJ BUTHISOSHAREDOHOST GETOBJECT)T CUVNEWVALTHIS CFILENAMEREFRESHPICTURE$TC%C O T T aT  U OSOURCENXCOORDNYCOORDONEWOBJTHISOSHARED DRAGDROP2CAPTIONCTEXTAUTOSIZECTARGET CFILENAME%C  B-)C\31 ENDPROC PROCEDURE getshellmenuitems LOCAL aShellOpts,lQView,i,lBold DIMENSION aShellOpts[1] aShellOpts = "" lQView = .F. IF !THIS.getshellinfo(@aShellOpts,@lQView) RETURN .F. ENDIF FOR i = 1 TO ALEN(aShellOpts,1) this.AddMenuBar(aShellOpts[m.i,2],"oTHIS.ShellRoutine('"+aShellOpts[m.i,1]+"')",,,,,m.i=1) ENDFOR * Add Quick View menu IF m.lQView this.AddMenuBar(MENU_QVIEW_LOC,"oTHIS.QuickView()") ENDIF ENDPROC PROCEDURE getdefaultshell LOCAL aShellOpts,lQView,cDefault,i DIMENSION aShellOpts[1] aShellOpts = "" cDefault = "" lQView = .F. IF THIS.getshellinfo(@aShellOpts,@lQView,@cDefault) AND; VARTYPE(m.cDefault)="C" AND !EMPTY(m.cDefault) RETURN m.cDefault ENDIF RETURN "" ENDPROC PROCEDURE getshellinfo LPARAMETERS aShellOptions, lHasQuickView, cDefault LOCAL cOptPath,oReg,aShellVerbs,aShellDefault,aShellCaptions LOCAL cExtnKey,cAppKey,cOptPath,i,cExtn,nError,cShell2,nPos DIMENSION aShellVerbs[1] DIMENSION aShellDefault[1,2] DIMENSION aShellCaptions[1] STORE "" TO aShellVerbs,aShellDefault cExtnKey = "" cAppKey = "" cExtn = JUSTEXT(this.cFileName) IF EMPTY(m.cExtn) RETURN .F. ENDIF oReg = this.oHost.GetObject(OBJ_REGISTRY) IF ISNULL(oReg) RETURN .F. ENDIF * Setup defaults DIMENSION aShellOptions[1,2] STORE "" TO aShellOptions nError = oReg.GetAppPath(m.cExtn,@cExtnKey,@cAppkey) IF nError #0 RETURN ENDIF cOptPath = ALLTRIM(m.cExtnKey) + SHELL_KEY nError = oReg.EnumOptions(@aShellVerbs,m.cOptPath,"",.T.) IF m.nError #0 RETURN ENDIF * Get Shell default DIMENSION aShellDefault[1,2] nError = oReg.EnumOptions(@aShellDefault,m.cOptPath,"") IF TYPE("aShellDefault[1,2]")="C" AND !EMPTY(aShellDefault[1,2]) * Set Shell default as first item cShellDefault = ALLTRIM(aShellDefault[1,2]) ELSE cShellDefault = SHELLDEFAULT ENDIF nPos = 0 FOR i = 1 TO ALEN(aShellVerbs) IF UPPER(ALLTRIM(aShellVerbs[m.i])) == UPPER(m.cShellDefault) cShellDefault = aShellVerbs[m.i] nPos = m.i ENDIF ENDFOR IF nPos#0 ADEL(aShellVerbs,m.nPos) AINS(aShellVerbs,1) aShellVerbs[1] = m.cShellDefault ENDIF * Search for Registry provided menu captions FOR i = 1 TO ALEN(aShellVerbs) *Check for Printto and loop IF ATC(SHELLPRINTTO,aShellVerbs[m.i])#0 LOOP ENDIF IF !EMPTY(aShellOptions[1]) DIMENSION aShellOptions[ALEN(aShellOptions,1)+1,2] ENDIF STORE aShellVerbs[m.i] TO aShellOptions[ALEN(aShellOptions,1),1] * Check if Caption provided DIMENSION aShellCaptions[1] nError = oReg.EnumOptions(@aShellCaptions,m.cOptPath+aShellVerbs[m.i],"") IF nError=0 AND TYPE("aShellCaptions[1,2]")="C" AND ; !EMPTY(aShellCaptions[1,2]) AND ATC(BINARYTYPE,aShellCaptions[1,2])=0 STORE STRTRAN(aShellCaptions[1,2],"&","\<") TO aShellOptions[ALEN(aShellOptions,1),2] ELSE cShell2 = aShellVerbs[m.i] DO CASE CASE ATC(m.cShell2,SHELLDEFAULT)#0 cShell2 = MENU_OPEN_LOC CASE ATC(m.cShell2,SHELLPRINT)#0 cShell2 = MENU_PRINT_LOC CASE ATC(m.cShell2,SHELLNEW)#0 cShell2 = MENU_NEW_LOC CASE ATC(m.cShell2,SHELLSHOW)#0 cShell2 = MENU_SHOW_LOC OTHERWISE cShell2=PROPER(m.cShell2) ENDCASE STORE m.cShell2 TO aShellOptions[ALEN(aShellOptions,1),2] ENDIF ENDFOR IF EMPTY(aShellOptions[1,1]) * special handling for Open With... * aShellOptions[1,1] = SHELLDEFAULT * aShellOptions[1,2] = MENU_OPENWITH_LOC ENDIF * Check to make sure all captions have hotkeys FOR i = 1 TO ALEN(aShellOptions,1) IF ATC("\<",aShellOptions[m.i,2])=0 aShellOptions[m.i,2] = "\<"+aShellOptions[m.i,2] ENDIF ENDFOR * Check if there is a QuickView association lHasQuickView = oReg.IsKey(QVIEWPATH+m.cExtn) cDefault = m.cShellDefault ENDPROC PROCEDURE addtoproject LPARAMETER cPJXName THIS.oShared.AddToProject(this.cFileName,m.cPJXName) ENDPROC PROCEDURE oshared_access IF VARTYPE(THIS.oShared) # "O" THIS.oShared = THIS.oHost.GetObject(OBJ_SHARED) ENDIF RETURN THIS.oShared ENDPROC PROCEDURE addtoform LPARAMETER cSCXName THIS.oShared.AddToForm(THIS,m.cSCXName) ENDPROC PROCEDURE cfilename_assign LPARAMETERS vNewVal THIS.cfilename = m.vNewVal THIS.RefreshPicture() ENDPROC PROCEDURE Destroy THIS.oShared = null ENDPROC PROCEDURE quickview LOCAL oReg, cQView, cFile, nErr cQView = "" oReg = this.oHost.GetObject(OBJ_REGISTRY) IF ISNULL(oReg) RETURN .F. ENDIF nErr = oREg.GetRegKey("",@cQView,QVIEWEXEPATH) IF ATC("%SystemRoot%",m.cQView)>0 m.cQView = GETENV("SYSTEMROOT")+ STRTRAN(m.cQView,"%SystemRoot%") ENDIF IF nErr#0 OR !FILE(m.cQView) RETURN .F. ENDIF RUN /n &cQView. "&cFile" ENDPROC PROCEDURE setmenu LPARAMETERS toObject LOCAL oProjMenu, lHasForm IF NOT DODEFAULT(toObject) RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF this.getshellmenuitems() this.AddMenuSeparator oProjMenu = THIS.NewMenu() THIS.oShared.AddProjectMenu(@oProjMenu) this.AddMenuBar(MENU_ADDPROJECT_LOC,oProjMenu,,,,_VFP.PROJECTS.COUNT=0) IF VARTYPE(THIS.cClass) = "C" AND !EMPTY(THIS.cClass) this.AddMenuSeparator oFormMenu = THIS.NewMenu() lHasForm = THIS.oShared.AddFormMenu(@oFormMenu) this.AddMenuBar(MENU_ADDFORM_LOC,oFormMenu,,,,!lHasForm) ENDIF ENDPROC PROCEDURE dblclick IF NOT DODEFAULT() OR !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF RETURN this.Run() ENDPROC PROCEDURE run IF NOT DODEFAULT() RETURN .F. ENDIF this.ShellRoutine(this.getdefaultshell()) ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF THIS.oShared.DragDrop2(oSource,nXCoord,nYCoord,THIS) ENDPROC PROCEDURE refreshpicture LOCAL lcExtn lcExtn= UPPER(JUSTEXT(THIS.cFileName)) DO CASE CASE lcExtn="DOC" THIS.cPicture = ICONFOLDER+ICO_MSWORD CASE lcExtn="XLS" THIS.cPicture = ICONFOLDER+ICO_MSEXCEL CASE lcExtn="PPT" THIS.cPicture = ICONFOLDER+ICO_MSPOWERPNT CASE INLIST(lcExtn,"MSG","OFT") THIS.cPicture = ICONFOLDER+ICO_MSOUTLOOK CASE INLIST(lcExtn,"CHM","HLP") THIS.cPicture = ICONFOLDER+ICO_HELP CASE !EMPTY(THIS.oParent.cFolderPicture) RETURN OTHERWISE THIS.cPicture = ICONFOLDER+ICO_FILE ENDCASE THIS.cPicture = THIS.FullPath(THIS.cPicture) ENDPROC  PROCEDURE buildapp * Check if project open already LOCAL nBuildAction,lBuildAll,lBuildErrors,cOutPutName LOCAL cExt,lHadError,cAction,i,lProjectIsOpen IF EMPTY(this.cFileName) OR !FILE(this.cFileName) RETURN .F. ENDIF lProjectIsOpen = .F. FOR i = 1 TO _VFP.Projects.Count IF UPPER(_VFP.Project[m.i].Name) = UPPER(THIS.cFileName) lProjectIsOpen = .T. EXIT ENDIF ENDFOR IF !m.lProjectIsOpen THIS.Modify() ENDIF nBuildAction = 0 * Give priority to nBuildAction parameter like in product cAction = UPPER(TRANS(THIS.nBuildAction)) DO CASE CASE m.cAction=="1" nBuildAction = 1 CASE INLIST(m.cAction,"2","APP") nBuildAction = 2 cExt = "APP" CASE INLIST(m.cAction,"3","EXE") nBuildAction = 3 cExt = "EXE" CASE INLIST(m.cAction,"4","DLL") nBuildAction = 4 cExt = "DLL" ENDCASE * Set output name cOutPutName = THIS.cOutputName DO CASE CASE m.nBuildAction > 1 cOutPutName=IIF(EMPTY(THIS.cOutputName),FORCEEXT(This.cFileName,m.cExt),FORCEEXT(THIS.cOutputName,m.cExt)) CASE m.nBuildAction = 1 cOutPutName = "" CASE UPPER(JUSTEXT(THIS.cOutputName))="APP" nBuildAction = 2 CASE UPPER(JUSTEXT(THIS.cOutputName))="EXE" nBuildAction = 3 CASE UPPER(JUSTEXT(THIS.cOutputName))="DLL" nBuildAction = 4 ENDCASE lBuildAll = IIF(TYPE("THIS.lBuildAll")="L",THIS.lBuildAll,.F.) lBuildErrors = IIF(TYPE("THIS.lBuildErrors")="L",THIS.lBuildErrors,.F.) lRunAfterBuild = IIF(TYPE("THIS.lRunAfterBuild")="L",THIS.lRunAfterBuild,.F.) lHadError = !_VFP.Projects[this.cFileName].Build(m.cOutPutName,m.nBuildAction,m.lBuildAll,m.lBuildErrors) IF m.lHadError RETURN ENDIF IF m.lRunAfterBuild AND INLIST(m.nBuildAction,2,3) DO (m.cOutPutName) ENDIF ENDPROC PROCEDURE modify IF NOT DODEFAULT() OR NOT THIS.lModify RETURN .F. ENDIF IF EMPTY(this.cFileName) OR !FILE(this.cFileName) RETURN .F. ENDIF MODIFY PROJECT (this.cFileName) NOWAIT ENDPROC PROCEDURE dblclick IF NOT DODEFAULT() RETURN .F. ENDIF RETURN this.Modify() ENDPROC PROCEDURE setmenu LPARAMETERS toObject IF NOT DODEFAULT(toObject) RETURN .F. ENDIF this.AddMenuBar(MENU_MODIFY_LOC,"oTHIS.Modify()",,,,,.T.) this.AddMenuBar(MENU_BUILD_LOC,"oTHIS.BuildApp()") ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord IF NOT DODEFAULT(oSource, nXCoord, nYCoord) OR; VARTYPE(oSource)#"O" OR !this.oHost.lDragDropToDesktop RETURN .F. ENDIF IF UPPER(oSource.BaseClass)="FORM" AND UPPER(oSource.Name)=VFP_SCREEN this.Modify() ENDIF ENDPROC  ?%Ui%C C,B-'TC B UCSHELLNERRTHISOHOST SHELLEXECUTE CFILENAMECPARAMS  T T-%C YB-(CRCC oTHIS.ShellRoutine('C ') % 0C \TC favorites%CB(TC _FileItem a-C C APP/ :8%!CCQWIZARDS\ APPHOOK.VCX0 y(TCQWIZARDS\ APPHOOK.VCXTAPPHOOKTC TC C / :-T7!DO (_WIZARD) WITH "Project",,,.T.U CTEMPLATE NPROJECTTYPEOPROJOCATALOGONODE LCHOOKFILE LCHOOKCLASSTHIS NDATABASETYPECDATABASETEMPLATE LRUNWIZARD OWIZSTYLESHOWCOUTFILE CPROJECTNAME LFAVORITES _OBROWSER GETFOLDER CREATENODEPROJECTSBUILDPROJECTHOOKLIBRARYPROJECTHOOKCLASSCLOSE UTHIS RESTORESETS CUTHISSAVESETS shellexec, autowizardEsavesetsopendata runwizardautoapp Destroy~Init1S3!qA1qqAA!AAqAAAA1AA3baa31qqAA#A#1AqQAQAAqA3rA!AA3r!A"!AqAA"AAAAQAA322g  ,= iD tbkt8Vf)W 3%<*UTC%C0 O CNo sample available.xB- H` C.SCX  C.FRX ?2 U LCSAMPLEFILETHIS LOCATESAMPLE$C UCSCXNAMETHISOSHARED ADDTOFORM<2C CfFORMUCPJXNAMETHISOSHARED ADDTOPROJECT CFILENAMECCLASS CBASECLASS6  1%CTHIS.cBaseClassbC C U B*%C.PRG C0  B%C#(C"%CC fCfTC Caa! BU AGETCLASSESITHIS CBASECLASS CFILENAMECCLASSWRITEPROPERTIES|TC%C0 W CNo sample available.xB-TCCPATHv G)(CCQFFCCCQWIZARDSCCQGALLERY HE C.SCX /&: C.FRX /3: C.PRGE /:%Ca G)(u G)(U LCSAMPLEFILE LCSETPATH LCFFCPATHTHIS LOCATESAMPLE ADDTOPATH4%C C CCfVCX ;B-yCCUTHIS CFILENAMECCLASSOHOST SWITCHBROWSERADDFILE SEEKCLASS  /cNewForm = PUTFILE("Select &form",'',"SCX") %C _B-%C0 CSCTT-TC SCX"& :QC`TCUATMPCNEWFORMTHISOHOST ALWAYSONTOPCCLASS CFILENAMELEFT. T TUVNEWVALTHISCCLASS CBASECLASSV%COC+TCVFPGLRY!SHAREDOBJ BUTHISOSHAREDOHOST GETOBJECT H C7 B" CCա C0 e B CCա)TCQsolution\solution.dbf%C0F Q%CC TCCf HQ SCXTF FRX;TR2QTZ'-CCfCCf Cf %C41TCQ solution\C\CTQ B BU LCFILENAMELCTYPELCEXTNTHIS CSAMPLEFILELCSOLUTIONSDBFFILETYPEPATHTCTCCPATHv%C HU C;tB CC;B CCC>RB%C G)(-G)(CCR;;6UTCPATHLCPATH LCSETPATH%C C 0B-T1 +CoForm bU}T CCC gZToForm PUBLIC &cFrmName. MR,:?.A public variable for form was created named: 6&cFrmName. = NEWOBJECT(this.cClass,this.cFileName) "IF VARTYPE(&cFrmName.)#"O"_CSThis class was not created -- possibly due to the INIT event returning a .F. value.xRELEASE &cFrmName. B&cFrmName..show UCSAVELIBNINCCFRMNAMETHIS CFILENAME%C  B-%Ca EB-    TC f*TCFORMFORMSETTOOLBART#TC  a  6T CCfPRG;C Mo\0 FOR i = 1 TO ALEN(aGetClasses,1) IF UPPER(aGetClasses[m.i,1]) == UPPER(THIS.cClass) THIS.cBaseClass = aGetClasses[m.i,2] THIS.WriteProperties(.T.,.T.) EXIT ENDIF ENDFOR ENDIF RETURN THIS.cBaseClass ENDPROC PROCEDURE opensample LOCAL lcSampleFile,lcSetPath,lcFFCPath lcSampleFile = THIS.LocateSample() IF !FILE(lcSampleFile ) MESSAGEBOX(MSG_NOSAMPLE_LOC) RETURN .F. ENDIF * Need to set paths in case sample needs to locate file lcSetPath = ALLTRIM(SET("PATH")) SET PATH TO THIS.AddToPath(HOME()+"FFC") THIS.AddToPath(HOME()+"WIZARDS") THIS.AddToPath(HOME()+"GALLERY") DO CASE CASE ATC(".SCX",lcSampleFile )#0 MODIFY FORM (lcSampleFile ) NOWAIT CASE ATC(".FRX",lcSampleFile )#0 MODIFY REPORT (lcSampleFile ) NOWAIT CASE ATC(".PRG",lcSampleFile )#0 MODIFY COMMAND (lcSampleFile) NOWAIT ENDCASE IF EMPTY(lcSetPath) SET PATH TO ELSE SET PATH TO (lcSetPath) ENDIF ENDPROC PROCEDURE viewbrowser IF EMPTY(this.cFileName) OR EMPTY(this.cClass) OR UPPER(JUSTEXT(this.cFileName))#"VCX" RETURN .F. ENDIF WITH this.oHost .SwitchBrowser .AddFile(this.cFileName) .SeekClass(this.cClass) ENDWITH ENDPROC PROCEDURE createform LOCAL aTmp,cNewForm DIMENSION aTmp[1] cNewForm = PUTFILE(C_SELECTFORM_LOC,'',"SCX") IF EMPTY(m.cNewForm) RETURN .F. ENDIF IF FILE(cNewForm) DELETE FILE (cNewForm) DELETE FILE (FORCEEXT(cNewForm,"SCT")) ENDIF THIS.oHost.AlwaysOnTop = .F. cNewForm = FORCEEXT(m.cNewForm,"SCX") CREATE FORM (m.cNewForm) AS (THIS.cClass) FROM (THIS.cFileName) NOWAIT * Ensure that form gets saved aSelObj(aTmp,1) aTmp[1].Left=aTmp[1].Left ENDPROC PROCEDURE cclass_assign LPARAMETERS m.vNewVal THIS.cclass = m.vNewVal THIS.cBaseClass = "" &&Reset ENDPROC PROCEDURE oshared_access IF VARTYPE(THIS.oShared) # "O" THIS.oShared = THIS.oHost.GetObject(OBJ_SHARED) ENDIF RETURN THIS.oShared ENDPROC PROCEDURE locatesample LOCAL lcFileName,lcType,lcExtn DO CASE CASE EMPTY(THIS.cSampleFile) * no sample file RETURN "" CASE !EMPTY(JUSTPATH(THIS.cSampleFile)) AND FILE(THIS.cSampleFile) * user provided RETURN THIS.cSampleFile CASE EMPTY(JUSTPATH(THIS.cSampleFile)) * no path - check solutions lcSolutionsDBF = HOME(2)+"solution\solution.dbf" IF FILE(lcSolutionsDBF) SELECT 0 USE (lcSolutionsDBF) AGAIN SHARED IF !EMPTY(ALIAS()) lcExtn = UPPER(JUSTEXT(THIS.cSampleFile)) DO CASE CASE lcExtn = "SCX" lcType = "F" CASE lcExtn = "FRX" lcType = "R" OTHERWISE lcType = "Z" ENDCASE LOCATE FOR UPPER(ALLTRIM(file)) == UPPER(JUSTSTEM(THIS.cSampleFile)) AND; UPPER(type) = lctype IF FOUND() lcFileName = HOME(2)+"solution\"+ALLTRIM(path)+"\"+ALLTRIM(THIS.cSampleFile) THIS.cSampleFile = lcFileName ENDIF USE RETURN THIS.cSampleFile ENDIF ENDIF ENDCASE RETURN THIS.cSampleFile ENDPROC PROCEDURE addtopath LPARAMETER tcPath LOCAL lcPath tcPath = ALLTRIM(tcPath) lcSetPath = ALLTRIM(SET("PATH")) IF ATC(tcPath,lcSetPath)#0 DO CASE CASE ATC(tcPath+";",lcSetPath)#0 RETURN CASE ATC(ADDBS(tcPath)+";",lcSetPath)#0 RETURN CASE ATC(RIGHT(lcSetPath,LEN(tcPath)),tcPath)#0 RETURN ENDCASE ENDIF IF EMPTY(lcSetPath) SET PATH TO (tcPath) ELSE SET PATH TO (lcSetPath + IIF(RIGHT(lcSetPath,1)=";","",";") + tcPath) ENDIF ENDPROC PROCEDURE run LOCAL cSaveLib,nInc,cFrmName IF NOT DODEFAULT() OR EMPTY(this.cFileName) RETURN .F. ENDIF nInc = "1" DO WHILE TYPE("oForm"+m.nInc)#"U" m.nInc=ALLT(STR(VAL(m.nInc)+1)) ENDDO cFrmName = "oForm"+m.nInc PUBLIC &cFrmName. WAIT WINDOW FORMNAMEVAR_LOC+m.cFrmName TIMEOUT .5 NOWAIT &cFrmName. = NEWOBJECT(this.cClass,this.cFileName) IF VARTYPE(&cFrmName.)#"O" MESSAGEBOX(ERR_OBJNOTCREATED_LOC) RELEASE &cFrmName. RETURN ENDIF &cFrmName..show ENDPROC PROCEDURE setmenu LPARAMETERS toObject IF NOT DODEFAULT(toObject) RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS,.T.) RETURN .F. ENDIF LOCAL lFormClass,lModifyAllow,lModifyDefault,lcBaseClass LOCAL oSampleMenu,oProjMenu,oFormMenu,lHasForm,lPRGClass lcBaseClass = UPPER(this.cBaseClass) lFormClass = INLIST(lcBaseClass,"FORM","FORMSET","TOOLBAR") lModifyAllow = this.lModify lModifyDefault = IIF(!m.lFormClass,.T.,!this.oHost.lRunFileDefault) lPRGClass = UPPER(JUSTEXT(THIS.cFileName))="PRG" * Modify and Run menus this.AddMenuBar(MENU_MODIFY_LOC,"oTHIS.Modify()",,,,!m.lModifyAllow,m.lModifyDefault) IF m.lFormClass this.AddMenuBar(MENU_RUN_LOC,"oTHIS.Run()",,,,,!m.lModifyDefault) IF lcBaseClass=="FORM" this.AddMenuBar(MENU_CLASSFORM_LOC,"oTHIS.CreateForm()") ENDIF ENDIF this.AddMenuBar(MENU_CLSBROWSER_LOC,"oTHIS.ViewBrowser()",,,,m.lPRGClass) * Add to Project menu - for Form classes mainly IF INLIST(lcBaseClass,"CUSTOM","CONTAINER") OR m.lFormClass OR m.lPRGClass this.AddMenuSeparator oProjMenu = THIS.NewMenu() THIS.oShared.AddProjectMenu(@oProjMenu) this.AddMenuBar(MENU_ADDPROJECT_LOC,oProjMenu,,,,_VFP.PROJECTS.COUNT=0) ENDIF * Add To Form menu - only for non form class types IF !m.lFormClass AND ATC(".VCX",this.cFileName)#0 &&VCX classes only oFormMenu = THIS.NewMenu() lHasForm = THIS.oShared.AddFormMenu(@oFormMenu) this.AddMenuBar(MENU_ADDFORM_LOC,oFormMenu,,,,!lHasForm) ENDIF this.AddMenuSeparator * View Sample menu IF FILE(THIS.LocateSample()) oSampleMenu = THIS.NewMenu() oSampleMenu.AddMenuBar(MENU_SAMPLEOPEN_LOC,"oTHIS.OpenSample()") oSampleMenu.AddMenuBar(MENU_SAMPLERUN_LOC,"oTHIS.ViewSample()") ELSE oSampleMenu = "" ENDIF this.AddMenuBar(MENU_SAMPLE_LOC,oSampleMenu,,,,!FILE(THIS.cSampleFile)) * Help menu this.AddMenuBar(MENU_HELP_LOC,"oTHIS.Help()") ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord LOCAL cMouseWin,oRef cMouseWin = MWINDOW() IF !THIS.oShared.CheckItem(THIS,.T.) RETURN .F. ENDIF DO CASE CASE VARTYPE(oSource)#"O" AND (UPPER(JUSTEXT(THIS.cFileName))="PRG" OR; LOWER(m.cMouseWin)#"command") RETURN .F. CASE VARTYPE(oSource)#"O" AND LOWER(m.cMouseWin)=="command" THIS.oHost.FormAddobject("command") CASE UPPER(this.cBaseClass)="FORM" AND UPPER(oSource.Name)=VFP_SCREEN AND; this.oHost.lDragDropToDesktop this.Run() OTHERWISE THIS.oShared.DragDrop2(oSource, nXCoord, nYCoord, THIS) ENDCASE oSource = null ENDPROC PROCEDURE modify LOCAL lcMethod,nStart,nEnd,lSaveIgnoreErrors IF NOT DODEFAULT() OR NOT THIS.lModify OR; EMPTY(this.cFileName) OR; (EMPTY(this.cClass) AND !ATC(".PRG",this.cFileName)#0) RETURN .F. ENDIF SET MESSAGE TO STAT_LOADCLASS_LOC DO CASE CASE ATC(".PRG",this.cFileName) #0 STORE 0 TO nStart,nEnd lSaveIgnoreErrors = THIS.oHost.lIgnoreErrors THIS.oHost.lIgnoreErrors = .T. STORE ATC(DEFCLASS+ALLTRIM(THIS.cClass),FileToStr(THIS.cFileName)) TO nStart,nEnd THIS.oHost.lIgnoreErrors = lSaveIgnoreErrors MODIFY COMM (this.cFileName) NOWAIT RANGE m.nStart,m.nEnd CASE EMPTY(this.cMethod) MODIFY CLASS (this.cClass) OF (this.cFileName) NOWAIT OTHERWISE lcMethod=ALLTRIM(this.cMethod) MODIFY CLASS (this.cClass) OF (this.cFileName) METHOD &lcMethod NOWAIT ENDCASE SET MESSAGE TO ENDPROC PROCEDURE dblclick IF NOT DODEFAULT() RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS,.T.) RETURN .F. ENDIF IF INLIST(UPPER(this.cBaseClass),"FORM","FORMSET","TOOLBAR") AND; this.oHost.lRunFileDefault this.Run() ELSE this.Modify() ENDIF ENDPROC PROCEDURE help LOCAL lcSaveHelpFile,lChangedHelp IF EMPTY(THIS.vHelpItem) MESSAGEBOX(NOHELP_LOC) RETURN ENDIF lChangedHelp=.F. lcSaveHelpFile = SET("HELP",1) IF SET("HELP") = "OFF" SET HELP ON ENDIF DO CASE CASE EMPTY(THIS.cItemHelpFile) AND ; (ATC(VFPHELPFILE,lcSaveHelpFile)#0 OR ATC(MSDNHELPFILE,lcSaveHelpFile)#0) * using VFP help -- FFC class CASE EMPTY(THIS.cItemHelpFile) SET HELP TO lChangedHelp=.T. CASE ATC(JUSTFNAME(THIS.cItemHelpFile),lcSaveHelpFile)=0 SET HELP TO (THIS.cItemHelpFile) lChangedHelp=.T. ENDCASE DO CASE CASE VARTYPE(THIS.vHelpItem)="C" HELP (THIS.vItemHelp) CASE VARTYPE(THIS.vHelpItem)="N" HELP ID (THIS.vHelpItem) ENDCASE IF lChangedHelp SET HELP TO (lcSaveHelpFile) ENDIF ENDPROC PROCEDURE Destroy THIS.oShared = null ENDPROC  %}WUTC 4%C OC olecontrol TT U CSCXNAMEOACTIVEXTHISOSHARED ADDTOFORM BASECLASSWIDTH NCTRLWIDTHHEIGHT NCTRLHEIGHT %C 0 C 0 3C'File name does not exist for this item.xB-RTCwindir5CCNTCJ CCJg  \SYSTEM32\ \SYSTEM\6T T- T a H$3 C 0 C 0 C fC f S%C<Would you like to update this item from its remote location?$xB- C 0 C 0 %CC ҡP2TC Select directory for control:3%C 3B-T C S%C<Would you like to update this item from its remote location?$xB-2 T -T T Ta% @! (C qA%CTHIS.aExtraFiles[m.i,1]bCCC  0 mTC (T C  7T CC CC  RT CCTHIS.aExtraFiles[m.i,2]bLC  a6 (C<&C (C %CC 0 8]CQCould not copy ActiveX file to local machine. Check for access or write problems.xB- (C%C CC  %C fC fT  T   T aT C %  T a% =Caa % 5C)ActiveX component successfully installed.xU CWINSYSDIR CTARGETDIR CTARGETFILECREGSVRI LWRITEPROPS ACOPYFILESNARRLEN CASSOCFILE LNERRORCODETHIS CFILENAME CREMOTEFILE LCOPYFILE AEXTRAFILESREGFILE GETPROGIDWRITEPROPERTIES%C B H, CCfDLLQ B CCfEXEv B2 BUTHIS CFILENAMEHTCTLB%C 0 TCOLB%C 0 mT%C 0 B%CO K%CO C AVCJCould not locate Object Browser. Check this setting in the Options dialog.xUCTYPELIBTHIS CFILENAME_OOBJECTBROWSERSHOW LOADTYPELIB TCVBRTCQ CLIREG32.EXE%C 0 dCXCould not locate CLIREG32.EXE in your FoxPro folder. Make sure it is properly installed.xB-%C C 0 b{CoCould not locate associated VBR file with ActiveX Server. Make sure it is installed in same location as server.xB-)RUN /N &cCliReg. "&cVBRFile." -NOLOGO UCVBRFILECCLIREGTHIS CFILENAMEBCUTHISOSHARED GETVERSION CFILENAMEJ&%CN  2 BC BUTHIS NCTRLHEIGHTJ&%CN  2 BC BUTHIS NCTRLWIDTH RTCwindir5CCNTCJ CCJg  \SYSTEM32\ \SYSTEM\6%CC fEXE RUN /N &cReGFile. /RegServer T  REGSVR32.EXE%C 0T   -s!RUN /N &cRegSvr. "&cReGFile." lC`Could not locate REGSVR32.EXE in your Windows System folder. Make sure it is properly installed.xB-UCREGFILECREGSVR CWINSYSDIRV%COC+TCVFPGLRY!SHAREDOBJ BUTHISOSHAREDOHOST GETOBJECT)T CUVNEWVALTHIS CFILENAMEREFRESHPICTURE!TCCL-6 %LT%C l B5 J(TC%Ca  B%CC TC%C4T C itempickerCQgallery\vfpglry.vcxT C  %CC0Only one class is registerd for this component: xbpCdComponent does not appear to be properly registered. Try selecting Install on my System menu option.x B %Caa BUTLRESETLRESETTHISCPROGID LCFILENAME AGETCONTROLSFULLPATH CFILENAMEOSHARED GETACTIVEXOCLASSOACTIVEXSETLISTSHOWWRITEPROPERTIES%%C  C 3B-%CCfPJXa/TCB UNERRTHISLMODIFYCSOURCEPROJECTOHOST SHELLEXECUTE%C /B-%C SB-TCDT  C % C f OLECONTROL  TCC f.% C C  GT CTC (C Add to \  "P9""]""f!#$j)custom vfpglry.hNAv( _datafolder vfpglry.hPixelsClass1_folder _datafolderk RRH% US%C  B-,C Mo\0 aServerName[2]= ALLTRIM(SUBSTRC(aServerName[2],1,lnPos-1)) ENDIF lnPOS = RATC(" -",aServerName[2]) IF lnPos>0 aServerName[2]= ALLTRIM(SUBSTRC(aServerName[2],1,lnPos-1)) ENDIF * Check to see if still not right file IF !FILE(aServerName[2]) IF TYPE("aServerName[4]")="C" AND FILE(aServerName[4]) aServerName[2] = aServerName[4] ELSE * SKIP control LOOP ENDIF ENDIF ENDIF IF EMPTY(m.cActiveXFile) OR; JUSTFNAME(UPPER(aServerName[2]))==JUSTFNAME(UPPER(m.cActiveXFile)) oReg.EnumOptions(@aControlName,cOptPath+aCLSIDs[m.i]) oReg.EnumOptions(@aProgID,cOptPath+aCLSIDs[m.i]+PROGID_KEY) IF !EMPTY(aControls[1,1]) DIMENSION aControls[ALEN(aControls,1)+1,3] ENDIF aControls[ALEN(aControls,1),1] = aControlName[2] aControls[ALEN(aControls,1),2] = aProgID[2] aControls[ALEN(aControls,1),3] = aServerName[2] ENDIF ENDIF ENDFOR WAIT CLEAR ENDPROC PROCEDURE getversion LPARAMETER cFileName IF PARAMETERS() < 1 OR !FILE(m.cFileName) RETURN .F. ENDIF LOCAL aVerArray,cVerString,nResult DIMENSION aVerArray[1] cVerString = "" nResult = aGetFileVersion(aVerArray,m.cFileName) IF nResult=0 MESSAGEBOX(FILEVER_NOVERSION_LOC,MSG_FILEVERSION_LOC+m.cFileName) RETURN ENDIF IF NOT EMPTY(aVerArray(1)) cVerString = FILEVER_COMMENT_LOC + ALLT(aVerArray(1)) ENDIF IF NOT EMPTY(aVerArray(2)) cVerString = m.cVerString+CRLF+FILEVER_COMPANY_LOC+ ALLT(aVerArray(2)) ENDIF IF NOT EMPTY(aVerArray(3)) cVerString = m.cVerString+CRLF+FILEVER_FILEDESC_LOC+ ALLT(aVerArray(3)) ENDIF IF NOT EMPTY(aVerArray(4)) cVerString = m.cVerString+CRLF+FILEVER_FILEVER_LOC+ ALLT(aVerArray(4)) ENDIF IF NOT EMPTY(aVerArray(5)) cVerString = m.cVerString+CRLF+FILEVER_INTERNAL_LOC+ ALLT(aVerArray(5)) ENDIF IF NOT EMPTY(aVerArray(6)) cVerString = m.cVerString+CRLF+FILEVER_COPYRIGHT_LOC+ ALLT(aVerArray(6)) ENDIF IF NOT EMPTY(aVerArray(7)) cVerString = m.cVerString+CRLF+FILEVER_TRADMARK_LOC+ ALLT(aVerArray(7)) ENDIF IF NOT EMPTY(aVerArray(8)) cVerString = m.cVerString+CRLF+FILEVER_FILENAME_LOC+ ALLT(aVerArray(8)) ENDIF IF NOT EMPTY(aVerArray(9)) cVerString = m.cVerString+CRLF+FILEVER_PRIVATE_LOC+ ALLT(aVerArray(9)) ENDIF IF NOT EMPTY(aVerArray(10)) cVerString = m.cVerString+CRLF+FILEVER_PRODUCTNAME_LOC+ ALLT(aVerArray(10)) ENDIF IF NOT EMPTY(aVerArray(11)) cVerString = m.cVerString+CRLF+FILEVER_PRODUCTVER_LOC+ ALLT(aVerArray(11)) ENDIF IF NOT EMPTY(aVerArray(12)) cVerString = m.cVerString+CRLF+FILEVER_SPECIAL_LOC+ ALLT(aVerArray(12)) ENDIF IF NOT EMPTY(aVerArray(14)) cVerString = m.cVerString+CRLF+FILEVER_LANGUAGE_LOC+ ALLT(aVerArray(14)) ENDIF IF NOT EMPTY(aVerArray(13)) &&OLESelfRegister cVerString = m.cVerString+CRLF+ALLT(aVerArray(13)) ENDIF IF EMPTY(m.cVerString) OR TYPE("aVerArray[1]")="L" cVerString = FILEVER_NOVERSION_LOC ENDIF MESSAGEBOX(m.cVerString,MSG_FILEVERSION_LOC+m.cFileName) ENDPROC PROCEDURE getwindowtypes LOCAL nTotWin,cSaveExact,nWinFlags,aVFPWindows DIMENSION aVFPWindows[1] nTotWin = THIS.GetWindowStack(@aVFPWindows) nWinFlags = 0 IF m.nTotWin # 0 cSaveExact = SET("EXACT") SET EXACT OFF nWinFlags = nWinFlags + IIF(ASCAN(aVFPWindows,WIN_PJX_DESIGN_LOC)=0,0,WIN_PJX_DESIGN_FLAG) nWinFlags = nWinFlags + IIF(ASCAN(aVFPWindows,WIN_SCX_DESIGN_LOC)=0,0,WIN_SCX_DESIGN_FLAG) nWinFlags = nWinFlags + IIF(ASCAN(aVFPWindows,WIN_VCX_DESIGN_LOC)=0,0,WIN_VCX_DESIGN_FLAG) nWinFlags = nWinFlags + IIF(ASCAN(aVFPWindows,WIN_FRX_DESIGN_LOC)=0,0,WIN_FRX_DESIGN_FLAG) nWinFlags = nWinFlags + IIF(ASCAN(aVFPWindows,WIN_MNX1_DESIGN_LOC)=0,0,WIN_MNX1_DESIGN_FLAG) nWinFlags = nWinFlags + IIF(ASCAN(aVFPWindows,WIN_MNX2_DESIGN_LOC)=0,0,WIN_MNX2_DESIGN_FLAG) nWinFlags = nWinFlags + IIF(ASCAN(aVFPWindows,WIN_DBC_DESIGN_LOC)=0,0,WIN_DBC_DESIGN_FLAG) SET EXACT &cSaveExact ENDIF RETURN nWinFlags ENDPROC PROCEDURE addprojectmenu LPARAMETER oProjMenu LOCAL lHasPJX,cPJXName lHasPJX = _VFP.Projects.Count>0 IF m.lHasPJX cPJXName= LOWER(_VFP.ActiveProject.Name) oProjMenu.AddMenuBar(m.cPJXName,"oTHIS.AddToProject(["+m.cPJXName+"])",,,,,.T.) FOR i = 1 TO _VFP.Projects.Count cPJXName= LOWER(_VFP.Projects[m.i].Name) IF LOWER(_VFP.ActiveProject.Name) == m.cPJXName LOOP ENDIF oProjMenu.AddMenuBar(m.cPJXName,"oTHIS.AddToProject(["+m.cPJXName+"])") ENDFOR ELSE oProjMenu = "" ENDIF RETURN m.lHasPJX ENDPROC PROCEDURE addformmenu LPARAMETER oFormMenu LOCAL lHasForm,cSCXName,i,aFrmObj lHasForm = .F. DIMENSION aFrmObj[1] IF ASELOBJ(aFrmObj,1)#0 cSCXName = LOWER(SYS(1271,aFrmObj[1])) cObjBase = UPPER(aFrmObj[1].BaseClass) IF LOWER(JUSTEXT(m.cSCXName))=="vcx" AND INLIST(m.cObjBase,"FORM","PAGE","TOOLBAR") oFormMenu.AddMenuBar(JUSTFNAME(m.cSCXName)+" ("+LOWER(aFrmObj[1].Name)+")","oTHIS.AddToForm(["+m.cSCXName+"])") lHasForm = .T. ENDIF ENDIF DIMENSION aVFPWindows[1] nTotWin = THIS.GetWindowStack(@aVFPWindows) FOR i = 1 TO nTotWin IF ATC(WIN_SCX_DESIGN_LOC,aVFPWindows[m.i])#0 lHasForm = .T. cSCXName = LOWER(SUBSTRC(aVFPWindows[m.i],LEN(WIN_SCX_DESIGN_LOC)+2)) oFormMenu.AddMenuBar(m.cSCXName,"oTHIS.AddToForm(["+m.cSCXName+"])") ENDIF ENDFOR IF !m.lHasForm oFormMenu = "" ENDIF RETURN m.lHasForm IF m.lHasForm cSCXName = LOWER(_VFP.ActiveProject.Name) oFormMenu .AddMenuBar(m.cSCXName,"oTHIS.AddToForm(["+m.cSCXName+"])",,,,,.T.) FOR i = 1 TO _VFP.Projects.Count cSCXName = LOWER(_VFP.Projects[m.i].Name) IF LOWER(_VFP.ActiveProject.Name) == m.cSCXName LOOP ENDIF ENDFOR ELSE oFormMenu = "" ENDIF ENDPROC PROCEDURE checkitem LPARAMETER oItem,lCheckClass LOCAL lcFileName,lcClass,lcGetFile,laGetClass,lnClasses,i DIMENSION laGetClass[1] lcFileName = oItem.cFileName IF lCheckClass IF UPPER(JUSTEXT(lcFileName)) = "VCX" lcClass = oItem.cClass ELSE lCheckClass=.F. ENDIF ENDIF IF !FILE(lcFileName) lcGetFile = oItem.oHost.LocateFile(lcFileName) DO CASE CASE ISNULL(lcGetFile) OR EMPTY(lcGetFile) &&cancelled RETURN .F. CASE lcGetFile == lcFileName &&ignored RETURN .F. CASE !FILE(lcGetFile) && bad file entered RETURN .F. ENDCASE oItem.cFileName = lcGetFile oItem.WriteProperties(.T.,.T.) ENDIF IF lCheckClass IF !FILE(lcFileName) RETURN .F. ENDIF lnClasses = AVCXCLASSES(laGetClass,lcFileName) FOR i = 1 TO lnClasses IF UPPER(laGetClass[m.i,1]) == UPPER(lcClass) RETURN ENDIF ENDFOR DIMENSION laGetClass[1] IF !AGETCLASS(laGetClass,lcFileName) OR !FILE(laGetClass[1]) RETURN .F. ENDIF oItem.cFileName = laGetClass[1] oItem.cClass = laGetClass[2] oItem.WriteProperties(.T.,.T.) ENDIF ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord, toObject LOCAL m.cWindow,lInScreen,cExt IF VARTYPE(oSource)#"O" OR VARTYPE(toObject)#"O" OR; NOT DODEFAULT(oSource, nXCoord, nYCoord) RETURN .F. ENDIF lInScreen = UPPER(oSource.Name)=VFP_SCREEN AND UPPER(oSource.BaseClass) == "FORM" cExt = UPPER(JUSTEXT(TRANS(toObject.cFileName))) DO CASE CASE m.lInScreen AND !toObject.oHost.lDragDropToDesktop RETURN .F. CASE m.lInScreen AND UPPER(toObject.cClass)=OLECONTROL_CLASS RETURN .F. CASE m.lInScreen AND INLIST(m.cExt,"DBF") RETURN .F. CASE m.lInScreen AND INLIST(m.cExt,"PJX","SCX","FRX","LBX","MNX","PRG","QPR","MPR","H","LOG","TXT") IF toObject.oHost.lRunFileDefault THIS.Run(toObject) ELSE THIS.Modify(toObject) ENDIF CASE UPPER(oSource.BaseClass)="PROJECT" IF UPPER(JUSTEXT(toObject.cFileName))="VCX" AND !EMPTY(toObject.cClass) THIS.AddToProject(toObject.cFileName,oSource.Name,toObject.cClass,UPPER(toObject.cBaseClass)=="FORM") ELSE THIS.AddToProject(toObject.cFileName,oSource.Name) ENDIF OTHERWISE RETURN THIS.ClassToForm(oSource,nXCoord,nYCoord,toObject) ENDCASE ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine ENDPROC PROCEDURE run LPARAMETERS toObject LOCAL cExt,lRunTimer,cCmd IF NOT DODEFAULT() OR !FILE(toObject.cFileName) RETURN .F. ENDIF cExt = UPPER(JUSTEXT(toObject.cFileName)) cCmd = toObject.cFileName lRunTimer = .F. IF TYPE("toObject.lRunTimer") = "L" lRunTimer = toObject.lRunTimer ENDIF DO CASE CASE cExt=="SCX" IF lRunTimer &&use for modal forms with ActX controls THIS.oHost.RunCodeTimer([DO FORM "&cCmd"]) ELSE DO FORM (toObject.cFileName) ENDIF CASE cExt=="PJX" MODIFY PROJECT (toObject.cFileName) NOWAIT CASE INLIST(cExt,"FRX","LBX") REPORT FORM (toObject.cFileName) PREVIEW CASE cExt=="MNX" MODIFY MENU (toObject.cFileName) NOWAIT CASE INLIST(cExt,"PRG","MPR","QPR") IF lRunTimer THIS.oHost.RunCodeTimer([DO "&cCmd"]) ELSE DO (toObject.cFileName) ENDIF CASE INLIST(cExt,"H","TXT","LOG") MODIFY FILE (toObject.cFileName) NOWAIT ENDCASE ENDPROC PROCEDURE modify LPARAMETERS toObject LOCAL cExt, lcMethod IF NOT DODEFAULT() OR !FILE(toObject.cFileName) OR !toObject.lModify RETURN .F. ENDIF cExt = UPPER(JUSTEXT(toObject.cFileName)) DO CASE CASE cExt=="SCX" lcMethod = ALLTRIM(toObject.cMethod) IF EMPTY(m.lcMethod) MODIFY FORM (toObject.cFileName) NOWAIT ELSE MODIFY FORM (toObject.cFileName) METHOD &lcMethod NOWAIT ENDIF CASE cExt=="PJX" MODIFY PROJECT (toObject.cFileName) NOWAIT CASE INLIST(cExt,"FRX","LBX") MODIFY REPORT (toObject.cFileName) NOWAIT CASE cExt=="MNX" MODIFY MENU (toObject.cFileName) NOWAIT CASE INLIST(cExt,"PRG","MPR","QPR") MODIFY COMMAND (toObject.cFileName) NOWAIT CASE INLIST(cExt,"H","TXT","LOG") MODIFY FILE (toObject.cFileName) NOWAIT ENDCASE ENDPROC >Y @>@>G%,7=aU8U2%C C O C C N B T1JC @( %C L    H checkboxTchk comboboxTcbo  commandbutton3Tcmd  commandgroupbTcmg  containerTctr controlTctl customTcst editbox Tedt form2Tfrm formset\Tfst gridTgrd imageTimg labelTlbl lineTlin listbox$Tlst  optionbuttonSTopt  optiongroupTopg" oleboundcontrolTolb  olecontrolTole  pageframe Tpgf shape4Tshp  separator`Tsep spinnerTspn textboxTtxt timerTtmr toolbarTtbr%C C:TC )+CoSource.  bUT CCC gZB  UOSOURCE CCLASSNAME CDATANAME LSHORTNAMENINCCNEWNAME    vT TCC   6%C BTC   H C f OLECONTROL>0%CtoObject.cProgIDbC C B-&C  olecontrol C.VCX yC   2C  +IF TYPE("oSource.&cNewObjName")#"O"B&oSourceObj = oSource.&cNewObjName. ):TCC N C D6:TCC N C D6%CfIMAGET 4%C .cFileNamebUCC fVCX T  %C.VisiblebL Ta CC%-CbuilderhCbuilderxh  C I%CaDropObjs[2].ShowWindowbUCC ShowWindowh  : BUOSOURCENXCOORDNYCOORDTOOBJECTCSAVELIB CNEWOBJNAME CFORMCLASSCFORMLIB OSOURCEOBJ ADROPOBJSCCLASSCFORMCLASSLIBRARY CFILENAMETHIS GENOBJNAMECPROGID ADDOBJECT NEWOBJECTLEFTWIDTHTOPHEIGHT BASECLASSPICTUREVISIBLESETFOCUSOHOSTLFFCBUILDERLOCKACTIVATEv  %CO2B8%C  C C CC fVCX %t,FORM DESIGNER -   %C` BTCCf*%C FORMPAGETOOLBAR *R,:No forms open...B% PAGEUBCCUTOOBJECT CFORMNAMEAFRMOBJCOBJBASE BASECLASSSHOWTHIS CLASSTOFORM T  T-%CC C C 0 yB"%C CC  T C '%C  CC fVCX TCcustomNClIsForm  &TC classdrop %COWCKOne of the gallery's components is in use. Operation could not be performedxB- T H C cNewClass C cFromClass  #C cFromClassLib  #C cSaveClassLib  %TCnewclass %COWCKOne of the gallery's components is in use. Operation could not be performedxB- %C'B--OQ:\{ENTER}<,CLASS DESIGNER -T /cNewForm = PUTFILE("Select &form",'',"SCX") %C B-TC SCX & :Q   C`!TC\{ENTER}<,FORM DESIGNER -T %C 0C  %C fCfC  %D*t,PROJECT MANAGER - C  HU ~/O : /& :U CFILENAME CPROJNAMECCLASSLISFORMOACTIONCNEWFORM OCLASSDROPNACTIONATMP CSAVEFILE ACTIVEPROJECTNAME ADDPROPERTYTHIS CLASSLIBRARYSHOW NGETACTION CNEWCLASS CSAVECLASSLIB CFROMCLASS CFROMCLASSLIBLEFTPROJECTSFILESADD %C+ BTCSCREEN   ('T CSCREEN  (&T  C  B U AWINSTACK NTOTALWINDOWSI ATMPARRAY'     #TCLSID\%C L T -%C CT T CC fIT  Software\Microsoft\VisualFoxPro\C\Options\OLEList(TC   6$TC  CLSID 6 J(TCRegObj%COB-5R,:*Reading Registry for ActiveX Components...%C 0 H8 CC TLB0jTC TLB CC OLB0TC OLB2T "TCtli.tliapplicationN%COR B-TC%CO4R B-(<%CC  CCC fOCX6%CC C#TCC !%CC5&%C  a"1R B-(CT C C dT%C GNR,:+Searching Registry for available classes...CC Z % complete J(-%C C a" Hu DLLTInProcServer32 EXET LocalServer322TControlT C % #.ZCC \C EXE LocalServer32InProcServer326"%CC0 TC /C%&TCCC굛TC -C%9&TCCC굛%CC0 /%CaServerName[4]bC CC0 TC.,%C CCCfCC f CC "*CC \ProgID"%CC XC#TCC#TCC#TCCR U# ACONTROLS LALLCONTROLS CACTIVEXFILE CTYPELIBFILEOTLIB OTYPEINFOOREGICOPTPATHNPOSNTOTDONECVFPKEYCEXTNOTFORMLNPOSACLSIDSAKEYSAPROGID ACONTROLNAME ASERVERNAMECSCANKEYICOUNT LCSERVERNAMEVERSIONCHKEY CACTIVEXKEYOTHISOHOST GETOBJECTTYPELIBINFOFROMFILE COCLASSESCOUNT ATTRIBUTEMASKGUID ENUMOPTIONS%C C 0 *B-  TTC %KCNo version information found.Version information for: xB%CC !T Comments: CC%CC V7T C C Company Name: CC%CC ;T C C File Description: CC%CC 7T C C File Version: CC%CC H8T C C Internal Name: CC%CC :T C C Legal Copyright: CC%CC ;T C C Legal Trademarks: CC%CC A<T C C Original Filename: CC%CC  8T C C Private Build: CC %CC  7T C C Product Name: CC %CC  2:T C C Product Version: CC %CC  8T C C Special Build: CC %CC 3T C C  Language: CC%CC   %T C C CC +%C C aVerArray[1]bL c*TNo version information found.0C Version information for: xU CFILENAME AVERARRAY CVERSTRINGNRESULT4 TC T% $TCEXACTvG;TCCPROJECT MANAGER -69TCCFORM DESIGNER -6:TCCCLASS DESIGNER -6;TCCREPORT DESIGNER -69TCCMENU DESIGNER -6=TCCSHORTCUT DESIGNER - 6=TCCDATABASE DESIGNER -@6SET EXACT &cSaveExact  BUNTOTWIN CSAVEEXACT NWINFLAGS AVFPWINDOWSTHISGETWINDOWSTACK@ TC% TCC@;C oTHIS.AddToProject([ ])a(CTCC C@%CC@ .6C oTHIS.AddToProject([ ]). T B U OPROJMENULHASPJXCPJXNAMEPROJECTSCOUNT ACTIVEPROJECTNAME ADDMENUBARI T- %C`TCCC]@TCCf>%CC @vcx C FORMPAGETOOLBAR MCC  (CC@)oTHIS.AddToForm([ ]) Ta  T C ( ,%CFORM DESIGNER -C   Ta1TCCC  CFORM DESIGNER ->@3C oTHIS.AddToForm([ ])%   T B % TCC @8C oTHIS.AddToForm([ ])a(CTCC C@%CC @ . TU OFORMMENULHASFORMCSCXNAMEIAFRMOBJCOBJBASE BASECLASS ADDMENUBARNAME AVFPWINDOWSNTOTWINTHISGETWINDOWSTACK ACTIVEPROJECTPROJECTSCOUNT7  T %%CCfVCXyT  T-%C0 :TC H CC B- B- C0 B-TCaa  %0%C0 bB-TC(%CC fCfB $%C CC0 B-TCT CCaa U OITEM LCHECKCLASS LCFILENAMELCCLASS LCGETFILE LAGETCLASS LNCLASSESI CFILENAMECCLASSOHOST LOCATEFILEWRITEPROPERTIES 8%CO CO C cB-0TCfSCREENCfFORM TCCC _f H   B-) C f OLECONTROL B- C DBF 6B-Z HC PJXSCXFRXLBXMNXPRGQPRMPRHLOGTXT % CC CfPROJECTk)%CC fVCX C F/C  CfFORMgC 2BCUOSOURCENXCOORDNYCOORDTOOBJECTCWINDOW LINSCREENCEXTNAME BASECLASS CFILENAMEOHOSTLDRAGDROPTODESKTOPCCLASSLRUNFILEDEFAULTTHISRUNMODIFY ADDTOPROJECT CBASECLASS CLASSTOFORMUNERRORCMETHODNLINE1%C C0 8B-TCCfT T-&%CtoObject.lRunTimerbLT H* SCX %.THIS.oHost.RunCodeTimer([DO FORM "&cCmd"])  PJX?/: CFRXLBXi? MNX/:! CPRGMPRQPR %)THIS.oHost.RunCodeTimer([DO "&cCmd"])   CHTXTLOG*/:UTOOBJECTCEXT LRUNTIMERCCMD CFILENAME &%C C0  ?B-TCCf He SCXTC%C /&:<MODIFY FORM (toObject.cFileName) METHOD &lcMethod NOWAIT  PJX/: CFRXLBX@/3: MNXc/:! CPRGMPRQPR/: CHTXTLOG/:UTOOBJECTCEXTLCMETHOD CFILENAMELMODIFYCMETHOD genobjname, classtoform addtoform6 addtoproject getwindowstack getactivex getversiongetwindowtypes$addprojectmenuI' addformmenu( checkitemv, dragdrop26/Error2run2modify)511(ARqqq!AArQAA31AqAqAaAqAbADAAB41AA3RqAQAqAbqArA31AA"AAraaQqqA11QQqqA!qAqAqAAQAAAA3qAbqAaA3q1qrArAAA1QqARA"QQqARQQqAAAA1AAA2aQqAAA111aaAAa1AACaAaABqBAAArA211AAAQ3qqAqAABAAqAAAAqAAAAAAAAAAAAqAAAAAA1AAQAA31R1AaA3qaAAAaAA4q1aAAQq1AAAAAAAA3AAqqqAAqAQqAAAAqAAAA31qAqqqq1AAA33qqAQaAAAAAAA3qbqARA!AAAA28HZ`Xz3,,UT,4A4779 :>>BKBCG|#_GG%GKG+K!N)@>$PROCEDURE addtoform LPARAMETERS cSCXName LOCAL oActivex oActivex = THIS.oShared.AddToForm(this,m.cSCXName) IF VARTYPE(m.oActiveX) = "O" AND ATC(oActiveX.BaseClass,"olecontrol")#0 oActiveX.Width = this.nCtrlWidth oActiveX.Height = this.nCtrlHeight ENDIF ENDPROC PROCEDURE addtosystem LOCAL cWinSysDir, cTargetDir, cTargetFile, cRegSvr, i, lWriteProps LOCAL aCopyFiles,nArrLen,cAssocFile,lnErrorCode IF !FILE(THIS.cFileName) AND !FILE(THIS.cRemoteFile) MESSAGEBOX(ERR_NOACTXFILE_LOC) RETURN .F. ENDIF DIMENSION aCopyFiles[1,3] cWinSysDir = GETENV("windir")+IIF(ATC("NT",OS())#0 OR VAL(OS(3))>=5,WINSYS_NT,WINSYS_W95) cTargetFile = THIS.cFileName lWriteProps = .F. lCopyFile = .T. *Copy file and associated files to proper directory if *not installed locally. Prompt user with default for *Windows system directory. This assumes that cFileName is *remote file name vs having cRemoteFile set properly. DO CASE CASE FILE(THIS.cRemoteFile) AND FILE(THIS.cFileName) AND ; UPPER(THIS.cRemoteFile)#UPPER(THIS.cFileName) * Both Remote and Local files exist IF MESSAGEBOX(MSG_REMOTEUPDATE_LOC,MSG_YESNO) # MSG_YES RETURN .F. ENDIF CASE FILE(THIS.cRemoteFile) AND !FILE(THIS.cFileName) * Remote exists, Local doesn't IF EMPTY(JUSTDRIVE(THIS.cFileName)) cTargetDir = GETDIR(m.cWinSysDir, MSG_GETCONTROL_LOC) IF EMPTY(m.cTargetDir) RETURN .F. ENDIF cTargetFile = m.cTargetDir+justfname(THIS.cFileName) ELSE IF MESSAGEBOX(MSG_REMOTEUPDATE_LOC,MSG_YESNO) # MSG_YES RETURN .F. ENDIF ENDIF OTHERWISE lCopyFile = .F. ENDCASE aCopyFiles[1,1] = THIS.cRemoteFile aCopyFiles[1,2] = m.cTargetFile aCopyFiles[1,3] = .T. *Do actual file copy here IF m.lCopyFile * Get list of Associated files to copy FOR m.i = 1 TO ALEN(THIS.aExtraFiles,1) IF TYPE("THIS.aExtraFiles[m.i,1]") = "C" AND FILE(THIS.aExtraFiles[m.i,1]) nArrLen = ALEN(aCopyFiles,1)+1 DIMENSION aCopyFiles[m.nArrLen,3] aCopyFiles[m.nArrLen,1] = THIS.aExtraFiles[m.i,1] aCopyFiles[m.nArrLen,2] = ADDBS(JUSTPATH(m.cTargetFile)) + JUSTFNAME(THIS.aExtraFiles[m.i,1]) aCopyFiles[m.nArrLen,3] = IIF(TYPE("THIS.aExtraFiles[m.i,2]")="L",THIS.aExtraFiles[m.i,2],.T.) ENDIF ENDFOR FOR m.i = 1 TO ALEN(aCopyFiles,1) COPY FILE (aCopyFiles[m.i,1]) TO (aCopyFiles[m.i,2]) IF !FILE(aCopyFiles[m.i,1]) MESSAGEBOX(ERR_BADCOPY_LOC) RETURN .F. ENDIF ENDFOR ENDIF *Register files even if file already local *User may have unregistered it. FOR m.i = 1 TO ALEN(aCopyFiles,1) IF aCopyFiles[m.i,3] THIS.RegFile(aCopyFiles[m.i,2]) ENDIF ENDFOR *Need to update filenames if necessary where cFileName is *somehow set to remote file name. IF UPPER(THIS.cFileName)#UPPER(m.cTargetFile) THIS.cRemoteFile = THIS.cFileName THIS.cFileName = m.cTargetFile m.lWriteProps = .T. ENDIF * Check for class if not yet associated * note: Class may already exist so skip writing it lnErrorCode = THIS.GetProgID() IF lnErrorCode=ERRCODE_GOODINSTALL m.lWriteProps = .T. ENDIF IF m.lWriteProps THIS.WriteProperties(.T.,.T.) ENDIF IF lnErrorCode#ERRCODE_FAILINSTALL MESSAGEBOX(MSG_GOODINSTALL_LOC) ENDIF ENDPROC PROCEDURE isserver IF EMPTY(THIS.cFileName) RETURN 0 ENDIF DO CASE CASE UPPER(justext(this.cFileName)) = INPROCSRV_EXTN &&In-Proc DLL RETURN ACTXDLLSVR CASE UPPER(justext(this.cFileName)) = LOCALSRV_EXTN &&Local Server EXE RETURN ACTXEXESVR OTHERWISE && Control RETURN ACTXCONTROL ENDCASE ENDPROC PROCEDURE viewtypelib #DEFINE NOOBJBROW_LOC "Could not locate Object Browser. Check this setting in the Options dialog." LOCAL cTypeLib cTypeLib= FORCEEXT(THIS.cFileName,TYPELIB_EXTN) IF !FILE(m.cTypeLib) cTypeLib= FORCEEXT(THIS.cFileName,TYPELIB2_EXTN) IF !FILE(m.cTypeLib) cTypeLib = THIS.cFileName ENDIF IF !FILE(m.cTypeLib) RETURN ENDIF ENDIF IF VARTYPE(_OOBJECTBROWSER)#"O" DO (_OBJECTBROWSER) ENDIF IF VARTYPE(_OOBJECTBROWSER)="O" _OOBJECTBROWSER.Show _OOBJECTBROWSER.LoadTypelib(m.cTypeLib) ELSE MESSAGEBOX(NOOBJBROW_LOC) ENDIF ENDPROC PROCEDURE regremote LOCAL cVBRFIle,cCliReg cVBRFile = FORCEEXT(THIS.cFileName,REMOTEREG_EXTN) cCliReg = (HOME()+CLIREG_FILE) IF !FILE(m.cCliReg) MESSAGEBOX(MSG_NOCLIREG32_LOC) RETURN .F. ENDIF IF EMPTY(m.cVBRFile) OR !FILE(m.cVBRFile) MESSAGEBOX(MSG_NOVBRFILE_LOC) RETURN .F. ENDIF RUN /N &cCliReg. "&cVBRFile." -NOLOGO ENDPROC PROCEDURE getversion RETURN THIS.oShared.GetVersion(this.cFileName) ENDPROC PROCEDURE nctrlheight_access IF VARTYPE(THIS.nCtrlHeight)="N" AND THIS.nCtrlHeight>0 RETURN THIS.nCtrlHeight ELSE RETURN DEFHEIGHT ENDIF ENDPROC PROCEDURE nctrlwidth_access IF VARTYPE(THIS.nctrlwidth)="N" AND THIS.nctrlwidth>0 RETURN THIS.nctrlwidth ELSE RETURN DEFWIDTH ENDIF ENDPROC PROCEDURE regfile *Register files even if file already local *User may have unregistered it. LPARAMETER cReGFile LOCAL cRegSvr,cWinSysDir cWinSysDir = GETENV("windir")+IIF(ATC("NT",OS())#0 OR VAL(OS(3))>=5,WINSYS_NT,WINSYS_W95) IF UPPER(JUSTEXT(m.cReGFile)) = "EXE" RUN /N &cReGFile. /RegServer ELSE * Check if REGSRV32 installed cRegSvr = m.cWinSysDir+REGSVR_FILE IF FILE(m.cRegSvr) m.cRegSvr = m.cRegSvr+" -s" &&add silent switch RUN /N &cRegSvr. "&cReGFile." ELSE MESSAGEBOX(MSG_NOREGSVR32_LOC) RETURN .F. ENDIF ENDIF ENDPROC PROCEDURE oshared_access IF VARTYPE(THIS.oShared) # "O" THIS.oShared = THIS.oHost.GetObject(OBJ_SHARED) ENDIF RETURN THIS.oShared ENDPROC PROCEDURE cfilename_assign LPARAMETERS vNewVal THIS.cfilename = m.vNewVal THIS.RefreshPicture() ENDPROC PROCEDURE getprogid LPARAMETER tlReset LOCAL lReset lReset = IIF(VARTYPE(tlReset)#"L",.F.,tlReset) IF lReset THIS.cProgID = "" ENDIF * Check for class if not yet associated IF !EMPTY(THIS.cProgId) RETURN ERRCODE_CLASSEXISTS ENDIF LOCAL lcFileName PRIVATE aGetControls DIMENSION aGetControls[1,2] STORE "" TO aGetControls lcFileName = THIS.FULLPATH(THIS.cFileName) IF !THIS.oShared.GetActivex(@aGetControls,.T.,lcFileName) RETURN ERRCODE_FAILINSTALL ENDIF IF !EMPTY(aGetControls[1]) THIS.cProgID = aGetControls[1,2] IF ALEN(aGetControls,1)#1 oClass = NewObject(ITEMPICKER_CLASS,HOME()+VFPGLRY_VCX) oClass.oActiveX = THIS oClass.SetList(@aGetControls) oClass.Show ELSE IF lReset MESSAGEBOX(MSG_ONECLASSREG_LOC+THIS.cProgID) ENDIF ENDIF ELSE MESSAGEBOX(MSG_NOCLASSREG_LOC) RETURN ERRCODE_FAILINSTALL ENDIF IF lReset THIS.WriteProperties(.T.,.T.) ENDIF RETURN ERRCODE_GOODINSTALL ENDPROC PROCEDURE modify LOCAL nErr IF NOT DODEFAULT() OR NOT THIS.lModify OR EMPTY(this.cSourceProject) RETURN .F. ENDIF IF UPPER(JUSTEXT(THIS.cSourceProject)) = PROJECT_EXTN MODIFY PROJECT (THIS.cSourceProject) ELSE nErr = this.oHost.ShellExecute(THIS.cSourceProject) RETURN m.nErr>31 ENDIF ENDPROC PROCEDURE setmenu LPARAMETERS toObject LOCAL cActXType,lAddForm, cExtn IF NOT DODEFAULT(toObject) RETURN .F. ENDIF IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF LOCAL lHasForm cActXType = THIS.IsServer() lAddForm = m.lHasForm AND !EMPTY(THIS.cProgID) AND (m.cActXType=ACTXCONTROL OR UPPER(THIS.cClass)#OLECONTROL_CLASS) cExtn = UPPER(JUSTEXT(THIS.cFileName)) * Add to form IF m.cActXType=ACTXCONTROL OR (!EMPTY(THIS.cClass) AND; !EMPTY(THIS.cFormClassLibrary)) oFormMenu = THIS.NewMenu() lHasForm = THIS.oShared.AddFormMenu(@oFormMenu) this.AddMenuBar(MENU_ADDFORM_LOC,oFormMenu,,,,!lHasForm) ENDIF * Modify ActiveX Control from source (e.g., VB Project) this.AddMenuBar(MENU_MODIFY_LOC,"oTHIS.Modify()",,,,EMPTY(THIS.cSourceProject)) this.AddMenuSeparator() * Install on my machine this.AddMenuBar(MENU_SYSTEM_LOC,"oTHIS.AddToSystem()",,,,EMPTY(THIS.cFileName)) * Change Registered Class this.AddMenuBar(MENU_NEWCLSID_LOC,"oTHIS.GetProgID(.T.)",,,,EMPTY(THIS.cFileName)) * Version Information this.AddMenuBar(MENU_VERSION_LOC,"oTHIS.GetVersion()",,,,EMPTY(THIS.cFileName)) * View Type Library information this.AddMenuBar(MENU_TYPELIB_LOC,"oTHIS.ViewTypeLib()") IF m.cActXType#ACTXCONTROL * Register remote * disabled for VFP8 since CLIREG32 no longer ships * this.AddMenuBar(MENU_REGREMOTE_LOC,"oTHIS.RegRemote()",,,,m.cExtn=INPROCSRV_EXTN) ENDIF ENDPROC PROCEDURE dragdrop2 LPARAMETERS oSource, nXCoord, nYCoord LOCAL oActiveX IF !THIS.oShared.CheckItem(THIS) RETURN .F. ENDIF oActiveX=THIS.oShared.DragDrop2(oSource, nXCoord, nYCoord, THIS) IF VARTYPE(oActiveX)="O" AND ATC(oActiveX.BaseClass,"olecontrol")#0 oActiveX.Width = this.nCtrlWidth oActiveX.Height = this.nCtrlHeight ENDIF ENDPROC PROCEDURE Init LOCAL i FOR i = 1 TO ALEN(THIS.aExtraFiles,1) STORE "" TO THIS.aExtraFiles[m.i,1] STORE .T. TO THIS.aExtraFiles[m.i,2] ENDFOR DoDefault() ENDPROC PROCEDURE Destroy THIS.oShared=null ENDPROC PROCEDURE refreshpicture LOCAL cExt cExt = UPPER(JUSTEXT(THIS.cFileName)) DO CASE CASE !EMPTY(THIS.cPicture) AND; !INLIST(LOWER(JUSTFNAME(THIS.cPicture)),ICO_ACTXEXE,ICO_ACTXDLL,ICO_ACTXOCX) CASE m.cExt = "EXE" THIS.cPicture = ICONFOLDER+ICO_ACTXEXE CASE m.cExt = "DLL" THIS.cPicture = ICONFOLDER+ICO_ACTXDLL OTHERWISE THIS.cPicture = ICONFOLDER+ICO_ACTXOCX ENDCASE THIS.cPicture = THIS.FullPath(THIS.cPicture) ENDPROC